返回列表 上一主題 發帖

[發問] VBA發mail異常 x32

yifan2599
　暱稱: Mick

贊助會員Rank: 2

帖子
37 
主題
10 
精華
0 
積分
55 
點名
0  
作業系統
Win10(x64) 
軟體版本
Office 2016 (x64) 
閱讀權限
30 
性別
男 
註冊時間
2011-1-31 
最後登錄
2021-9-15 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 »
發表於 2014-12-4 10:18 | 只看該作者

VBA發mail異常 x64

各位，請幫忙解惑一下 ~
先前有反應x64發送郵件會出現異常，後來已經有排除。
但不知道為什麼，今天才這樣 ~
他竟然出現底下視窗無法傳送，請各位幫忙一下
感謝


程式碼:
Public Declare PtrSafe Function SetTimer Lib "user32" _
        (ByVal hwnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Public Declare PtrSafe Function KillTimer Lib "user32" _
        (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)



Function WinProcA(ByVal hwnd As Long, ByVal uMsg As Long, _
        ByVal idEvent As Long, ByVal SysTime As Long) As Long
    KillTimer 0, idEvent
    DoEvents
    Sleep 100
    '使用 Alt + s 鍵來傳送郵件
    Application.SendKeys "%s"
End Function
Sub Mail()
    Dim objOL As Object
    Dim itmNewMail As Object
    收件者 = Worksheets("供應商包材").Cells(1, 50)
    副本 = Worksheets("供應商包材").Cells(2, 50)
    '先存檔
    ThisWorkbook.Save
    '引用Microsoft Outlook 物件模型
    Set objOL = CreateObject("Outlook.Application")
    Set itmNewMail = objOL.CreateItem(olMailItem)
    With itmNewMail
        .Subject = "【每日】" & "CORE架台進銷存_" & DateTime.Date '主旨
        .Body = DateTime.Date & " CORE架台進銷存       該檔案會於每日下班前送出"   '本文
        .To = 收件者    '收件者"
        .cc = 副本
        '.BCC = "yifan"
        '指定附件的路徑
        .Attachments.Add ThisWorkbook.FullName
        .Display  '啟動視窗
        SetTimer 0, 0, 0, AddressOf WinProcA
    End With
    Set objOL = Nothing
    Set itmNewMail = Nothing
End Sub

人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。

TOP

yifan2599
　暱稱: Mick

贊助會員Rank: 2

帖子
37 
主題
10 
精華
0 
積分
55 
點名
0  
作業系統
Win10(x64) 
軟體版本
Office 2016 (x64) 
閱讀權限
30 
性別
男 
註冊時間
2011-1-31 
最後登錄
2021-9-15 

論壇榮譽勳章論壇贊助勳章
2# 倒序看帖
打印
tT
發表於 2014-12-4 10:38 | 只看該作者

[發問] VBA發mail異常 x32

outlook
各位，請幫忙解惑一下 ~
使用x32系統發送時，A電腦可以 B電腦卻不行，出現底下異常畫面~~
為什麼阿 !?

程式碼:
Public Declare PtrSafe Function SetTimer Lib "user32" _
        (ByVal hwnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Public Declare PtrSafe Function KillTimer Lib "user32" _
        (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)



Function WinProcA(ByVal hwnd As Long, ByVal uMsg As Long, _
        ByVal idEvent As Long, ByVal SysTime As Long) As Long
    KillTimer 0, idEvent
    DoEvents
    Sleep 100
    '使用 Alt + s 鍵來傳送郵件
    Application.SendKeys "%s"
End Function
Sub Mail()
    Dim objOL As Object
    Dim itmNewMail As Object
    收件者 = Worksheets("供應商包材").Cells(1, 50)
    副本 = Worksheets("供應商包材").Cells(2, 50)
    '先存檔
    ThisWorkbook.Save
    '引用Microsoft Outlook 物件模型
    Set objOL = CreateObject("Outlook.Application")
    Set itmNewMail = objOL.CreateItem(olMailItem)
    With itmNewMail
        .Subject = "【每日】" & "CORE架台進銷存_" & DateTime.Date '主旨
        .Body = DateTime.Date & " CORE架台進銷存       該檔案會於每日下班前送出"   '本文
        .To = 收件者    '收件者"
        .cc = 副本
        '.BCC = "yifan"
        '指定附件的路徑
        .Attachments.Add ThisWorkbook.FullName
        .Display  '啟動視窗
        SetTimer 0, 0, 0, AddressOf WinProcA
    End With
    Set objOL = Nothing
    Set itmNewMail = Nothing
End Sub

收藏 分享
人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。

        靜思自在 : 道德是提昇自我的明燈，不該是呵斥別人的鞭子。
返回列表 上一主題