如何在excel中将带有附件的电子邮件发送到gmail

Question

我实际上有两个问题。我的第一个错误是“对象不支持属性或方法”。 Is 是代码中的 .add 附件行。当我发表评论时，它将处理良好，直到“NewMail.Configuration = mailConfig”行出现“运行时错误（20）”。我只是没有在代码中看到问题。

我不是编码员，但我们最接近 excel 开发。此代码最初是为 Outlook 编写的，但电子邮件地址已更改为 gmail，所以我被要求为 gmail 修改它。代码的文件创建部分保持不变。我尝试了两种不同的借用代码来发送 gmail 电子邮件。我尝试了几种不同的方式来描述添加附件行的文件名。我对运行时错误感到茫然。出于显而易见的原因，我更改了电子邮件地址。

Sub Mail_workbook_Outlook_2()

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String

    Set wb1 = ActiveWorkbook
    If Val(Application.Version) >= 12 Then
    If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
        MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
               "be no VBA code in the file you send. Save the" & vbNewLine & _
               "file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
        Exit Sub
    End If
End If

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

' Make a copy of the file.
' If you want to change the file name then change only TempFileName variable.
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, _
                               Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

'On Error GoTo Err

Dim NewMail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL As String

Set NewMail = Nothing
Set mailConfig = Nothing

Set NewMail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.Configuration")

' load all default configurations
mailConfig.Load -1

Set fields = mailConfig.fields

'Set All Email Properties

With NewMail
    .Subject = "QUOTE FORM"
    .From = "123456@gmail.com"
    .To = "123456@gmail.com; 234567@gmail.com; 345678@gmail.com"
    .CC = ""
    .BCC = ""
    .TextBody = ""
    '.AddAttachment = wb1("TempFilePath & TempFileName & FileExtStr")
End With


With fields
    'Enable SSL Authentication
    .Item(msConfigURL & "/smtpusessl") = True

    'Make SMTP authentication Enabled=true (1)
    .Item(msConfigURL & "/smtpauthenticate") = 1

    'Set the SMTP server and port Details
    'To get these details you can get on Settings Page of your Gmail Account
    .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
    .Item(msConfigURL & "/smtpserverport") = 465
    .Item(msConfigURL & "/sendusing") = 2

    'Set your credentials of your Gmail Account
    .Item(msConfigURL & "/sendusername") = "12345@gmail.com"
    .Item(msConfigURL & "/sendpassword") = "34567"

    'Update the configuration fields
    .Update

End With


NewMail.Configuration = mailConfig
On Err GoTo Err2
Err2:
Resume Next
NewMail.Send
MsgBox ("Mail has been Sent")

Exit_Err:

Set NewMail = Nothing
Set mailConfig = Nothing
End

Err:
Select Case Err.Number

Case -2147220973  'Could be because of Internet Connection
    MsgBox " Could be no Internet Connection !!  -- " & Err.Description

Case -2147220975  'Incorrect credentials User ID or password
    MsgBox "Incorrect Credentials !!  -- " & Err.Description

Case Else   'Rest other errors
    MsgBox "Error occured while sending the email !!  -- " & 
Err.Description
End Select

Resume Exit_Err


wb2.Close SaveChanges:=False

' Delete the file.
Kill TempFilePath & TempFileName & FileExtStr


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

Answer 1

您尚未在代码中的任何位置定义 msConfigURL。添加

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

看看会发生什么。