附件不与CDO Gmail一起发送或附件为空

时间:2014-06-13 15:30:59

标签: vba gmail attachment cdo.message

当我运行以下子时,gmail将在没有附件的情况下发送。如果我为附件设置变量,并将.AddAttachment语句更改为.AddAttachment(FName),则会附带电子邮件附件,但该附件为空。请帮忙。这是我的代码:

Sub SendEmail()

Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Dim Msg As String
Dim iBp As CDO.IBodyPart

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields

With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
                    = "stmpCorpServer"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = _
            InputBox("Please enter your email address")
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = _
            InputBox("Please enter your password")
    .Update
End With

'Set Variables

Msg = "Record Count - " & EmlRcrdCt & vbNewLine & _
        "Store Count - " & EmlStrCt & vbNewLine & _
        "Record Count for shelf on hand > 6*+1 shelf capacity - " & _
        EmlRcrdCtShlf6 & vbNewLine & _
        "Record count for shelf on hand > 0 and capacity 0 - " & _
        EmlRcrdCtShlf0 & vbNewLine & _
        "Record count for quantity of adjustment=0 and adjustment quantity>0 - " & _
        EmlRcrdQty0 & vbNewLine & _
        "Record count for quantity of adjustment>0 and adjustment quantity=0 - " & _
        EmlRcrdCtQtyGrtr0 & vbNewLine & vbNewLine & _
        "Attached is a spreadsheet of the 'store' counts and 'shelf on hand' counts." & _
        vbNewLine & _
        "Please let me know if you have any questions." & vbNewLine & vbNewLine & _
        EmlMisStrs & vbNewLine & _
        EmlLgVar & vbNewLine

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

'Set email settings
    On Error Resume Next

    With iMsg
        Set .Configuration = iConf
        .To = "MyEmail"
        .From = """Julia"" <MyEmail>"
        .CC = "MyEmail"
        .BCC = ""
        .Subject = "CAO results for week ending " & LstDayInWk
        .TextBody = Msg
        .AddAttachment "C:\CAO\SS CAO we 06072014.xlsx"
        .Send
    End With

    On Error GoTo 0

'Activate Control Sheet
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

End Sub

0 个答案:

没有答案