未在Excel / VBA中使用Gmail和CDO发送附件

我正在尝试通过CDO和gmail将活动工作表发送给在某些文本框中输入的所有人，以将他们发送出去。我使用以下代码：

Sub CommandButton1_Click()

'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim ProjectName As String
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim recipientsArray(1 To 10) As String
Dim i As Long
Dim qScore As String

recipientsArray(1) = TextBox1.Value
recipientsArray(2) = TextBox2.Value
recipientsArray(3) = TextBox3.Value
recipientsArray(4) = TextBox4.Value
recipientsArray(5) = TextBox5.Value
recipientsArray(6) = TextBox6.Value
recipientsArray(7) = TextBox7.Value
recipientsArray(8) = TextBox8.Value
recipientsArray(9) = TextBox11.Value
recipientsArray(10) = TextBox10.Value

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

Set Sourcewb = ThisWorkbook

'Copy the ActiveSheet to a new workbook
ThisWorkbook.ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2013
        Select Case Sourcewb.FileFormat
        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
        Case 52:
            If .HasVBProject Then
                FileExtStr = ".xlsm": FileFormatNum = 52
            Else
                FileExtStr = ".xlsx": FileFormatNum = 51
            End If
        Case 56: FileExtStr = ".xls": FileFormatNum = 56
        Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
    End If
End With

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
If Sourcewb.Worksheets("Final Review Feedback").Range("B4").Value = "" Then
    TempFileName = "No project name"
Else
    TempFileName = Sourcewb.Worksheets("Final Review Feedback").Range("B2").Value & " " & Sourcewb.Worksheets("Final Review Feedback").Range("D4").Value
End If

If Sourcewb.Worksheets("Extraction").Range("C1").Value = "" Then
    ProjectName = "N/A"
Else
    ProjectName = Sourcewb.Worksheets("Extraction").Range("C1").Value
End If

If Sourcewb.Worksheets("Final Review Feedback").Range("D4").Value = 0 Then
    qScore = "QScore: N/A"
Else
    qScore = "QScore: " & Sourcewb.Worksheets("Final Review Feedback").Range("D4").Value
End If

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/sendusername") = "[email protected]"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*******************"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Update
End With

With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    On Error Resume Next
    For i = LBound(recipientsArray) To UBound(recipientsArray)
        If Not recipientsArray(i) = "" Then
            Set iMsg = CreateObject("CDO.Message")
            With iMsg
                Set .Configuration = iConf
                .To = recipientsArray(i)
                .CC = ""
                .BCC = ""
                .Subject = "Final Review Feedback: " & ProjectName & " " & qScore
                .TextBody = "Dear All," & Chr(10) & Chr(10) & "attached you will find the Final Review Feedback for " & ProjectName & "." _
                    & Chr(10) & Chr(10) & "Yours sincerely," & Chr(10) & Environ("Username")
                .from = """Final Review"" <[email protected]>"
                .ReplyTo = "[email protected]"
                .AddAttachment (TempFilePath & TempFileName & FileExtStr)
                .Send
            End With
        End If
    Next i
    On Error GoTo 0
    .Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set iMsg = Nothing
Set iConf = Nothing

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

Me.Hide

Sheet9.Range("N2").Value = "Awaiting Upload"

End Sub

除附件外，其他所有内容（文本，收件人，主题等）均正常运行。它们不包含在电子邮件中。由于代码我曾尝试.Attachments.Add和.AddAttachments。两者都具有相同的结果。

我仔细检查了文件名是否正确，似乎没问题。有谁知道为什么我发送空电子邮件？我尝试发送活动的工作簿（同时将其打开并处于活动状态）会不会有问题？