通过Gmail发送Excel文件

时间:2014-01-15 18:37:28

标签: excel vba email

执行宏后,可以通过Gmail帐户发送Excel文件。

1 个答案:

答案 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