通过VBA通过电子邮件发送工作簿

我可以请求一些关于这个代码的帮助吗？请参阅下面的代码：

Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
'    Dim Flds As Variant

Set wb = ActiveWorkbook

If Val(Application.Version) >= 12 Then
    If wb.FileFormat = 51 And wb.HasVBProject = True Then
        MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
               "Save the file first as xlsm and then try the macro again.", vbInformation
        Exit Sub
    End If
End If

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Make a copy of the file/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Recycling Survey"
FileExtStr = "." & LCase(Right(wb.Name, Len(wb.Name) - InStrRev(wb.Name, ".", , 1)))

wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1    ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "blah@gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "****"
    .Update
End With

With iMsg
    Set .Configuration = iConf
    .To = "blah@blah.com"
    .CC = ""
    .BCC = ""
    .From = "blah@gmail.com"
    .Subject = "Please see my recycling survey submission " & Date
    .TextBody = ""
    .AddAttachment TempFilePath & TempFileName & FileExtStr
    .Send
End With

'If you not want to delete the file you send delete this line
Kill TempFilePath & TempFileName & FileExtStr

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

MsgBox ("Your survey form has been submitted")

我从Ron de Bruin那里得到的代码似乎对我和我的一位同事有效，我要求他们测试它。但是另一个人（此电子表格的目标受众）遇到了错误：运行时错误（80040213）：传输无法连接到服务器。

---

关于如何修复此代码以使其适用于所有用户的任何线索？提前谢谢

您是否尝试了端口465？我尝试使用其他端口，但这次我可以得到一个传输错误代码：80040211，错误表明无法将邮件发送到SMTP服务器。我唯一建议的另一件事是检查您的网络和防火墙设置，以确保您有一个到服务器的开放路径。有可能它被阻塞了。你试过465端口吗？我试过使用另一个端口，但是这次我可以得到一个传输错误代码：80040211，错误表明无法将邮件发送到SMTP服务器。我唯一建议的另一件事是检查您的网络和防火墙设置，以确保您有一个到服务器的开放路径。它可能被阻塞了。