VBA 之呼叫CDO介面傳送郵件
阿新 • • 發佈：2021-10-07
VBA自帶的語法可以處理Outlook郵箱,但是缺點是outlook還需要配置,
但是呼叫系統自帶的CDO介面可以用SMTP模式傳送各大第三方的郵箱,只需要開啟POP3/SMTP模式即可,相容性更好.
Sub CDOSENDEMAIL() 'On Error Resume Next '出錯後繼續執行 Application.DisplayAlerts = False '禁用系統提示 'ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly '將工作簿設定為只讀模式 Set CDOMail = CreateObject("CDO.Message") '建立物件 CDOMail.From = "[email protected]" '設定發信人的郵箱 CDOMail.To = "[email protected]" '設定收信人的郵箱 CDOMail.Subject = "主題:用CDO傳送郵件試驗" '設定郵件的主題 CDOMail.TextBody = "文字內容" '使用文字格式傳送郵件似乎不能換行,只能切換成HTML模式換行." CDOMail.HtmlBody = "使用html" & "<br>" & "換行後的內容" '使用Html格式傳送郵件 'CDOMail.AddAttachment ThisWorkbook.Path & "\" & "a" & ".xlsx" '傳送當前目錄下的工作簿a為附件 stUl = "http://schemas.microsoft.com/cdo/configuration/" '微軟伺服器網址 'stUl = "http://pop.sina.com" '微軟伺服器網址 With CDOMail.Configuration.Fields '.Item(stUl & "smtpusessl") = True .Item(stUl & "smtpserver") = "smtp.sina.com" 'SMTP伺服器地址 .Item(stUl & "smtpserverport") = 25 'SMTP伺服器埠 465 是ssl連線 25是普通連線 .Item(stUl & "sendusing") = 2 '傳送埠 .Item(stUl & "smtpauthenticate") = 1 '遠端伺服器需要驗證 .Item(stUl & "sendusername") = "[email protected]" '傳送方郵箱名稱 .Item(stUl & "sendpassword") = "授權碼" '上面連線生成的授權碼，非你qq郵箱密碼 .Item(stUl & "smtpconnectiontimeout") = 60 '連線超時（秒） .Update End With CDOMail.Send '執行傳送 Set CDOMail = Nothing '傳送成功後即時釋放物件 'If Err.Number = 0 Then 'MsgBox "成功傳送郵件", , "溫馨提示" '如果沒有出錯，則提示傳送成功 'Else 'MsgBox Err.Description, vbInformation, "郵件傳送失敗" '如果出錯，則提示錯誤型別和錯誤程式碼 'End If 'ThisWorkbook.ChangeFileAccess Mode:=xlReadWrite '將工作簿設定為讀寫模式 'Kill ThisWorkbook.Path & "\" & "a" & ".xlsx" '新工作簿刪除 'Call dayin Application.DisplayAlerts = True '恢復系統提示 End Sub