执行宏后,可以通过Gmail帐户发送Excel文件。
答案 0 :(得分:0)
社区维基。答案在评论中。任何在搜索中找到此主题的人都会看到答案,并且更有可能寻找有希望的有用答案。
"此link显示了如何使用VBA使用您的Gmail帐户发送电子邮件。" - sigil
复制了仅链接答案。
以下是一个代码段,如果您拥有有效的用户名和密码,则可以通过Gmail的SMTP服务器使用VBA发送电子邮件。
请注意,下面的大部分内容不是我的代码,我只是修改它,以便该功能可以在没有硬编码值的情况下工作。原作者的信息也可以在下面找到。
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'>>> Database by Tony Hine, alias Uncle Gizmo <<<
'>>> Created Mar, 2011 <<<
'>>> Last up-dated Mar, 2011 <<<
'>>> Telephone International: +44 1635 522233 <<<
'>>> Telephone UK: 01635 533322 <<<
'>>> e-mail: email@tonyhine.co.uk <<<
'>>> Skype: unclegizmo <<<
'>>> I post at the following forum (mostly) : <<<
'>>> http://www.access-programmers.co.uk/forums/ (alias Uncle Gizmo) <<<
'>>> You can also find me on the Ecademy: http://www.ecademy.com/user/tonyhine<<<
'>>> try this website: http://www.tonyhine.co.uk/example_help.htm <<<
'>>> I have now started a forum which contains video instructions here: <<<
'>>> http://msAccessHintsAndTips.Ning.Com/ <<<
'>>> CODE SUPPLIED NOT CHECKED AND TESTED FOR ERRORS!!!! Be Warned <<<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Public Function fSendGmail(ByVal sTo As String, ByVal sEmail As String, ByVal sPass As String, _
ByVal strMsg As String, ByVal strSubject As String) As Boolean 'Returns True if No Errors
On Error GoTo Err_ErrorHandler
fSendGmail = True
'Extract
'This basic example sends a simple, no-frills text message every time the script is run: '
'Example File script0603.vbs '
'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 conSendPassword As String = "YourGmailPasswordHere"
Const conCdoBasic As Integer = 1
'Const conSendUserName As String = "YourGmailAddrHere@gmail.com"
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
Dim oMsg As Object
Dim oConf As Object
Dim strEmailAddr As String
'CHANGE THIS!!
'strEmailAddr = sTo & ""
'Create Objects
Set oMsg = CreateObject("CDO.Message")
Set oConf = CreateObject("CDO.Configuration")
Set oMsg.Configuration = oConf
'Build the Message
With oMsg
.To = "" & sTo 'If incorrect you will get an email From: Delivery Status Notification (Failure) Delivery to the following recipient failed permanently:
.From = "Grievance Tracker <" & sEmail & ">" 'If incorrect raises this Error: -2147220973
.Subject = strSubject
.textBody = strMsg
'.AddAttachment "H:\ATHDrive\ATH_Programming\ATH_Office\Access2007\My_MS_Access_Tools\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") = sEmail
.Item(conStrPrefix & "sendpassword") = sPass
'.Item(conStrPrefix & "sendusername") = conSendUserName 'IF you want to hard code the username you can reactivate this line.
'.Item(conStrPrefix & "sendpassword") = conSendPassword 'IF you want to hard code the password you can reactivate this line.
.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