想要使用 VBA 來寄送 GMail 郵件，就要應用到 CDO(Collaboration Data Objects) 的功能。但是實務上的使用，就算是不知道什麼是 CDO？
也可以輕鬆應用它來寄送郵件。
以下是網路既有的函數，程式指令直接照抄，只要修正部分指令內容即可。（有加上底色的區域）
Private Function fSendGmail() As Boolean 'Returns True if No Errors are Generated
On Error GoTo Err_ErrorHandler
fSendGmail = True
'Extract
'The SendMail() Function
'While longer, SendMail( ) is itself a simpler function than GetData( ) . It simply creates three
'objects: CDO. Message, CDO. Configuration, and a subobject of CDO. Configuration called
'Fields . The Scripting library used in GetData() is a default part of the ASP namespace, and
'therefore any new object created in the Scripting library is known. To use objects in the CDO
'library, the METADATA statements at the top of the ASP page are necessary.
'Standard CDO Constants
'NOTE --- If you set conCdoSmtpUseSSL to True, you may need to set conCdoSendUsingPort to 465 or port number specified by your ISP.
Const conStrPrefix As String = "http://schemas.microsoft.com/cdo/configuration/"
Const conCdoSendUsingPort As Integer = 2 'If incorrect raises this Error: -2147220960
Const conCdoBasic As Integer = 1
Const conStrSmtpServer As String = "smtp.gmail.com" 'If incorrect raises this Error: -2147220973
Const conCdoSmtpUseSSL As Boolean = True 'Use Secure Sockets Layer (SSL) when posting via SMTP.
Const conCdoSmtpServerPort As Integer = 465 'Can be 465 or 587 'If incorrect raises this Error: -2147220973
Const conSendUserName As String = "pertonchang@gmail.com"
Const conSendPassword As String = "**********"
Dim oMsg As Object
Dim oConf As Object
Dim strEmailAddr As String
strEmailAddr = "pertonchang@gmail.com"
'Create Objects
Set oMsg = CreateObject("CDO.Message")
Set oConf = CreateObject("CDO.Configuration")
Set oMsg.Configuration = oConf
'Build the Message
With oMsg
.To = "Testing <" & strEmailAddr & ">"
.From = "From TextBox <pertonchang@gmail.com>" 'If incorrect raises this Error: -2147220973
.Subject = "From Keyed in Email Address"
.TextBody = "From Keyed in Email Address"
.AddAttachment "H:\GoogleEmail\TransscriptGmailFromVBA.txt"
End With
''Set Delivery Options
With oConf.Fields
.Item(conStrPrefix & "sendusing") = conCdoSendUsingPort
.Item(conStrPrefix & "smtpserver") = conStrSmtpServer
.Item(conStrPrefix & "smtpauthenticate") = conCdoBasic
.Item(conStrPrefix & "sendusername") = conSendUserName
.Item(conStrPrefix & "sendpassword") = conSendPassword
.Item(conStrPrefix & "smtpusessl") = conCdoSmtpUseSSL
.Item(conStrPrefix & "smtpserverport") = conCdoSmtpServerPort
.Update 'Commit Changes
End With
'Deliver the Message
oMsg.send
Exit_ErrorHandler:
'Access 2007 Developer Reference > Microsoft Data Access Objects (DAO) Reference > DAO Reference > Recordset Object > Methods
'An alternative to the Close method is to set the value of an object variable to Nothing (Set dbsTemp = Nothing).
Set oMsg.Configuration = Nothing
Set oConf = Nothing
Set oMsg = Nothing
Exit Function
Err_ErrorHandler:
If Err.Number <> 0 Then fSendGmail = False
Select Case Err.Number
Case -2147220977 'Likely cause, Incorrectly Formatted Email Address, server rejected the Email Format
MsgBox "Error From --- fSendGmail --- Incorrectly Formatted Email --- Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description, , "Format the Email Address Correctly"
Case -2147220980 'Likely cause, No Recipient Provided (No Email Address)
MsgBox "Error From --- fSendGmail --- No Email Address --- Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description, , "You Need to Provide an Email Address"
Case -2147220960 'Likely cause, SendUsing Configuration Error
MsgBox "Error From --- fSendGmail --- The SendUsing configuration value is invalid --- LOOK HERE >>> sendusing) = conCdoSendUsingPort --- Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description, , "SendUsing Configuration Error"
Case -2147220973 'Likely cause, No Internet Connection
MsgBox "Error From --- fSendGmail --- No Internet Connection --- Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description, , "No Internet Connection"
Case -2147220975 'Likely cause, Incorrect Password
MsgBox "Error From --- fSendGmail --- Incorrect Password --- Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description, , "Incorrect Password"
Case Else 'Report Other Errors
MsgBox "Error From --- fSendGmail --- Error Number >>> " & Err.Number _
& " <<< Error Description >> " & Err.Description
End Select
Resume Exit_ErrorHandler
End Function 'fSendGmail
沒有留言:
張貼留言