標題: [發問] VBA發mail異常 x32 [打印本頁]

---

作者: yifan2599    時間: 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

[attach]19701[/attach]

---

作者: yifan2599    時間: 2014-12-4 10:38     標題: VBA發mail異常 x32

各位，請幫忙解惑一下 ~
使用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

[attach]19702[/attach]

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)