iInfo 資訊交流: Excel VBA使用CDO物件，分別透過Gmail、Hotmail、Yahoo寄信

2016年4月16日星期六

Excel VBA使用CDO物件，分別透過Gmail、Hotmail、Yahoo寄信

原本要在DDE收資料檔案中新增寄信功能，經過實驗與尋找發現到一些網路上很少人注意到的部分，在這裡一起記錄起來。
使用Excel VBA寄信以下幾種方法，分別為使用CDO物件、使用Outlook物件、使用Sendkeys控制Outlook Express，今天先介紹使用CDO物件的方法，後續再介紹使用Outlook物件方法。

透過Gmail寄信
在使用Gmail寄信前，請先到Google的「低安全性應用程式」網頁中，設定安全性較低的應用程式存取權限作開啟，如果沒有做這個動作，將會遭受懲罰(哈哈)，是無法經由Gmail做寄信的動作。

由於需使用到CDO物件，在編寫VBA程式碼前，須先設定引用"Microsoft CDO for Windows 2000 Library"。

 Sub 藉由Gmail寄信()
    Dim mail As New Message
    Dim config As Configuration
    Set config = mail.Configuration
    '
    config(cdoSMTPAuthenticate) = cdoBasic
    '設定SSL加密傳送
    config(cdoSMTPUseSSL) = True
    '設定smtp主機
    config(cdoSMTPServer) = "smtp.gmail.com"
    '設定stmp port，預設為25，也可使用465
    config(cdoSMTPServerPort) = 25

    config(cdoSendUsingMethod) = cdoSendUsingPort
    '填寫您的gmail郵件位址
    config(cdoSendUserName) = "white5168@gmail.com"
    '填寫上述郵件位址的使用者密碼
    config(cdoSendPassword) = "********"
  
    config.Fields.Update
  
    '寄件對象
    With mail
        '寄件者
        .From = "white5168@gmail.com"
        '收件者
        .To = "white5168@gmail.com;white-5168@yahoo.com.tw;white_5168@hotmail.com"
        '副本收件者
        .CC = "white5168@gmail.com"
        '密件副本收件者
        .BCC = "white5168@gmail.com"
        '信件主旨
        .Subject = "VBA透過Gmail寄mail"
        '內容編碼
        .BodyPart.Charset = "utf-8"
        '網頁格式信件內容，須以HTML方式來編寫
        .HTMLBody = "測試內容"
        '附件存放位置
        '.AddAttachment "檔案路徑"
        
        On Error Resume Next
        '開始船送mail
        .Send
        If Err.Number <> 0 Then
            MsgBox Err.Description, vbCritical, "信件無法寄出"
            Exit Sub
        Else
             MsgBox "信件已寄出", vbInformation, "信件寄出狀態"
        End If
    End With
End Sub

結果：

透過Hotmail寄信

Sub 藉由Hotmail寄信()
    Dim Mail As CDO.Message
     
    Set Mail = New CDO.Message
    
    With Mail.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-mail.outlook.com"
        
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "white_5168@hotmail.com"
        
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "********"
    
        .Update
    End With
    
    With Mail
        .Subject = "VBA透過Hotmail寄mail"
        .From = "white_5168@hotmail.com"
        .To = "white5168@gmail.com;white-5168@yahoo.com.tw;white_5168@hotmail.com"
        .CC = "white_5168@hotmail.com"
        .HTMLBody = "測試內容"
        .BodyPart.Charset = "utf-8"
        .HTMLBodyPart.Charset = "utf-8"
        .Send
    End With

    MsgBox "信件已寄出", vbInformation, "寄出"

    Set Mail = Nothing
 End Sub

透過Yahoo寄信

Sub 藉由Yahoo寄信()
    Dim Mail As CDO.Message
    
    Dim sURL As String
         
    Set Mail = New CDO.Message

    sURL = "http://schemas.microsoft.com/cdo/configuration/"
    
    With Mail.Configuration.Fields
        .Item(sURL & "smtpusessl") = True
        
        .Item(sURL & "smtpauthenticate") = 1
        
        .Item(sURL & "smtpserver") = "smtp.mail.yahoo.com"
        
        .Item(sURL & "smtpserverport") = 25
        
        .Item(sURL & "sendusing") = 2
        
        .Item(sURL & "sendusername") = "white-5168@yahoo.com.tw"
        
        .Item(sURL & "sendpassword") = "********"
        
        .Update
    End With
    
    With Mail
        .Subject = "VBA透Yahoo寄mail"
        .From = "white-5168@yahoo.com.tw"
        .To = "white5168@gmail.com;white-5168@yahoo.com.tw;white_5168@hotmail.com"
        .CC = "white-5168@yahoo.com.tw"
        .HTMLBody = "測試內容"
        .BodyPart.Charset = "utf-8"
        .HTMLBodyPart.Charset = "utf-8"
        .Send
    End With
        
    MsgBox "信件已寄出", vbInformation, "寄出"
    
    Set Mail = Nothing 
End Sub

PS：以上3個信箱寄信的方法，除了SMTP Server有不同外，Gmail寄信的設定也須注意。

參考資料

iInfo 資訊交流

最新消息

2016年4月16日星期六

Excel VBA使用CDO物件，分別透過Gmail、Hotmail、Yahoo寄信

LinkWithin

最新消息

2016年4月16日 星期六

Excel VBA使用CDO物件，分別透過Gmail、Hotmail、Yahoo寄信

LinkWithin

2016年4月16日星期六