Отправить файл Excel через gmail

Question

После выполнения макроса можно отправить файл Excel через учетную запись gmail.

Answer 1

Сообщество wiki. Ответ в комментарии. Любой, кто найдет эту тему в поиске, увидит, что есть ответ и, скорее всего, найдет полезный ответ.

«Это link показывает, как использовать VBA для отправки электронной почты с помощью учетной записи gmail». - sigil

Ссылка только на копирование.

---

Ниже приведен фрагмент кода, который позволит вам отправить электронное письмо с помощью VBA через серверы SMTP Gmail, если у вас есть правильные имя пользователя и пароль.

Обратите внимание, что основная часть ниже не является моим кодом, я просто изменил ее так, чтобы функция могла работать без жестко заданных значений. Исходную информацию автора также можно найти ниже.

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
'>>> 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