问题
I'm trying to send a mail with Microsoft Office Excel 2007 VBA code but I'm getting the error:
Run-time error '-2147220973 (80040213)':
Automation error
The code that I'm using is:
Dim cdomsg As Object
Set cdomsg = CreateObject("CDO.message")
With cdomsg.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "excel.**********@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "**********123"
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
End With
With cdomsg
.Subject = "Automated mail"
.From = "excel.**********@gmail.com"
.To = "**********@hitbts.com" ' https://temp-mail.org/
.TextBody = "Automated mail"
.AddAttachment ("*:\*****\***********\****************\***********\*****\*****.xlsm")
.Send
End With
Set cdomsg = Nothing
I have tried other smpt servers, the server name and address that shows in the cmd when I type in nslookup, the computer's IP and another IP but I don't know what's the correct smpt server.
Edit after answer:
To anyone searching for this in the future, the code I used and worked is the following (taken from this video):
Dim Mail As New Message
Dim Config As Configuration
Set Config = Mail.Configuration
Config(cdoSendUsingMethod) = cdoSendUsingPort
Config(cdoSMTPServer) = "smtp.gmail.com"
Config(cdoSMTPServerPort) = 25
Config(cdoSMTPAuthenticate) = cdoBasic
Config(cdoSMTPUseSSL) = True
Config(cdoSendUserName) = "sender@gmail.com"
Config(cdoSendPassword) = "password123"
Config.Fields.Update
Mail.AddAttachment ("C:\path\file.ext")
Mail.To = "destination@gmail.com"
Mail.From = Config(cdoSendUserName)
Mail.Subject = "Email Subject"
Mail.HTMLBody = "<b>Email Body</b>"
Mail.Send
Make sure to change "sender@gmail.com", "password123", "C:\path\file.ext" and "destination@gmail.com" for the example to work and the subject and body to change the mail.
I also went to the top menu "Tools" on the VBA, option "References...", enabled "Microsoft CDO for Windows 2000 Library" and pressed OK as shown in the video linked above.
Direct link to enable the "Less Secure" option for GMail taken from here.
回答1:
As you're using Gmail; did you check whether enabling 'less secure apps' made a difference? Support.google.com Reference
回答2:
Huhlo,
I have been using a similar code to the one discussed here. It had been very reliable in many different operation systems and Office/ Excel versions. It had also worked reliably in different countries in different internet connections and providers. On a recent trip to Malta, it failed to work on the two different computers I had with me, which had different systems and Office/ Excel versions. I tried different internet connections and providers, without success.
I cured the problem, so I am sharing the solution in case it may help anyone passing here in the future.
In brief, the solution was to change the smptserverport") = 25 to smptserverport") = 465
( I note in passing that in previous similar codings of mine, (using both as Sending provider my gmail.com Email address and also my German Telekom , t-online.de , Email address ) that the coding worked with either 25 or 465. ( I had been using 25 in preference to 465, simply because I had seen that used more often in similar codings ) )
Here is the full implantation of my solution, which works well for me.
I have changed my signature line of my procedure from this
Sub PetrasDailyProWay1_COM_Way()
so that it now takes in, as value thereof, the “smptserverport” number
Sub PetrasDailyProWay1_COM_Way(ByVal SmptySvrPrt)
Any Call of the routine, which I had, such as this Call line I had
Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'" & "!ProAktuelleMacrosMtsch.PetrasDailyProWay1_COM_Way"
is now modified to pass the value of 25, thus:
Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'" & "!ProAktuelleMacrosMtsch.PetrasDailyProWay1_COM_Way" , arg1:="25"
( The above code line runs the procedure, Sub PetrasDailyProWay1_COM_Way( ) , which, in my case, is in another workbook to that in which the Call line is in . ( The workbook, "NeuProAktuelleMakros.xlsm" , is automatically opened if it is not already open, by that code line ) )
I now have added, towards the end of my routine, Sub PetrasDailyProWay1_COM_Way( ) , error handling which schedules a re run of that routine, using the 465, if the initial run, using 25 , fails. ( This particular solution has the additional advantage that I get automatically a second try, in the cases where, in the original coding, it had previously, occasionally, did not work at the first attempt )
This was my previous end of my coding:
Rem 3 Do it
.send
MsgBox Prompt:="Done"
End With ' CreateObject("CDO.Message") (Rem 1 Library End =======#
End Sub
Here is the now modified version:
Rem 3 Do it initially attempt with 25 , then in Malta as well maybe with 465
On Error GoTo Malta ' Intended to catch a possible predicted error in the next line when running the routine in Malta, or/ and an error in the second attempt at a code run ' if the next line errors, then I scheduule the routine to run again with "smtpserverport") = 465
.send
On Error GoTo 0
MsgBox Prompt:="Done (with " & SmptySvrPrt & ")" ' This will typically give either "Done (with 25)" or else "Done (with 465)" if the routine worked
End With ' CreateObject("CDO.Message") (Rem 1 Library End =======#
Exit Sub ' Normal routine end for no error exceptional errected situation
Malta: ' Intended to catch a predicted error when running the routine in Malta, or/ and an error in the second attempt at a code run
If SmptySvrPrt = "465" Then MsgBox Prompt:="Also did not work with 465 , Oh Poo!": Exit Sub ' case error with attempt with 465
Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'" & "!'ProAktuelleMacrosMtsch.PetrasDailyProWay1_COM_Way ""465""'"
' On Error GoTo -1: On Error GoTo 0 ' I do not need this as the End Sub will effectively bring down the errection state
End Sub
The syntax I am using in the Application.OnTime code line was quite tricky to figure out. ( It is more complicated than I need , but I wanted to keep the format consistent with that used in my Call code lines).
I could not figure out how to do that last bit of the Application.OnTime code line with the argument somehow in ( ) brackets. I also could not figure out how to do that code line using named arguments, which I personally prefer. I did manage to do it with named arguments, if I called a procedure that took no arguments. But in the case of a procedure taking arguments, as is the case with the new modified code here, I could not find any syntax that worked. So if anyone can enlighten me on how to do that line in a working syntax, in a form similar to this pseudo form, ( that does not work) , then I would be very interested.
Application.OnTime EarliestTime:=Now(), Procedure:="'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'" & "!'ProAktuelleMacrosMtsch.PetrasDailyProWay1_COM_Way, arg1:=""465""'"
The use of 465 in place of 25 has been mentioned before , as have using one or the other. I have yet to see any explanation of what this “smptserverport” or other parameters really are, at least , in any form understandable to me. If anyone has any clear explanation, it would be an interesting addition here , in my opinion. ( Links to any existing explanations are no use to me, as I think I have seen them all . …. … I expect it may be one of those things that no one ever got around to documenting clearly, and in the meantime no one can remember what it is all about )
ThunkUs : - ) Alan
来源：https://stackoverflow.com/questions/48020578/excel-vba-cdo-mail