最新消息

[公告2014/05/30] 如有需要將部落格中,任何一篇文章的程式碼使用在商業用途,請與我聯繫。

[公告2015/04/26] Line版的 iInfo程式與投資應用 群組已上線想加入的朋友們,請先查看 "入群須知" 再與我聯繫 Line : aminwhite5168,加入請告知身分與回答 "入群須知" 的問題。

[公告2018/04/22] 台北 Python + Excel VBA 金融資訊爬蟲課程,課程如網頁內容 金融資訊爬蟲班:台北班 Python 金融資訊爬蟲、EXCEL VBA 金融資訊爬蟲

[公告2019/01/08] 請注意:我再次重申,部落格文章的程式碼,是要提供各位參考與學習,一旦網頁改版請自行修改,別要求東要求西要我主動修改,你們用我寫東西賺錢了、交差了,請問有分我一杯羹嗎?既然賺錢沒分我,請問有什麼理由要求我修改,如果沒能力改,就花錢來找我上課。

[公告2019/12/01] 若各位有 Excel VBA 案子開發需求,歡迎與我聯繫,可接案處理。

[公告2020/05/22] 頁面載入速度慢,起因為部分JS來源(alexgorbatchev.com)失效導致頁面載入變慢,目前已做調整,請多見諒。

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寄信的設定也須注意。

參考資料