Excel VBA - CDO.message経由で電子メールを送信 - 添付ファイルを追加できません

Question

Gmail SMTP経由でメールを送信するためにこのチュートリアルを実行していますが、添付ファイルを追加すると失敗します。

http://www.learnexcelmacro.com/wp/2011/12/how-to-send-an-email-using-excel-macro-from-gmail-or-yahoo/

私は、ユーザーのTEMP AppDataフォルダに保存されているアクティブなブックのコピーを送信しようとしています。私は一時ファイルをトレースし、ファイルの存在を確認して問題はないはずですが、それを添付しているようには見えません。しかし、私がファイルをハードコーディングすると（例えば "C：\ temp \ file.xls"）ファイルを添付することはできますが、ファイルパスが変数で指定されている場合はできません。

誰でも正しい方向に私を指摘できますか？私は、このようなGmail_Attachment変数にパスを定義するか、TempFilePath & TempFileName & FileExtStr変数を追加するなど、いくつかの構文のを試してみましたが、ちょうど明確にする ：私は...アイデアのうち、

EDITています。私はそれを文字通り.addattachment "C：/path/file.xls"として記述した場合にのみ、それらのどれも動作しません。

Sub Mail_Gmail() 
'Working in 2000-2010 
    Dim FileExtStr As String 
    Dim FileFormatNum As Long 
    Dim Sourcewb, Destwb As Workbook 
    Dim TempFilePath, TempFileName As String 
    Dim SendTo, SendCC, Holidex, Property, QCI_Mgr, Position As Range 
    Dim Gmail_ID, Gmail_PWD, Gmail_SMTP, Gmail_attachment As String 

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

    Set Sourcewb = ActiveWorkbook 
    Set SendTo = ActiveWorkbook.Sheets("Settings").Range("B20") 
    Set SendCC = ActiveWorkbook.Sheets("Settings").Range("B21") 
    Set Holidex = ActiveWorkbook.Sheets("Settings").Range("B5") 
    Set Property = ActiveWorkbook.Sheets("Settings").Range("B4") 
    Set QCI_Mgr = ActiveWorkbook.Sheets("Settings").Range("B14") 
    Set Position = ActiveWorkbook.Sheets("Settings").Range("B15") 

    Gmail_SMTP = "smtp.gmail.com" 
    Gmail_ID = "user@gmail.com" 
    Gmail_PWD = "password" 

    'Copy the sheet to a new workbook 
    ActiveSheet.Copy Before:=Sheets(1) 
     With ActiveSheet 
      If ActiveSheet.AutoFilterMode Then 
       ActiveSheet.AutoFilterMode = False 
      End If 

      '.ShowAllData     ' disable autofilters 
      .Cells.Copy 
      .Cells.PasteSpecial xlValues 
     End With 
     Application.CutCopyMode = False 

    ActiveSheet.Copy 

    Set Destwb = ActiveWorkbook 

    'Determine the Excel version and file extension/format 
    With Destwb 
     If Val(Application.Version) < 12 Then 
      'You use Excel 2000-2003 
      FileExtStr = ".xls": FileFormatNum = -4143 
     Else 
      'You use Excel 2007-2010, we exit the sub when your answer is 
      'NO in the security dialog that you only see when you copy 
      'an sheet from a xlsm file with macro's disabled. 
      If Sourcewb.Name = .Name Then 
       With Application 
        .ScreenUpdating = True 
        .EnableEvents = True 
       End With 
       MsgBox "Your answer is NO in the security dialog" 
       Exit Sub 
      Else 
       Select Case Sourcewb.FileFormat 
       Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 
       Case 52: 
        If .HasVBProject Then 
         FileExtStr = ".xlsm": FileFormatNum = 52 
         'FileExtStr = ".pdf": FileFormatNum = 17 
        Else 
         FileExtStr = ".xlsx": FileFormatNum = 51 
        End If 
       Case 56: FileExtStr = ".xls": FileFormatNum = 56 
       Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 
       End Select 
      End If 
     End If 
    End With 


    'Change all cells in the worksheet to values if you want 
    'With Destwb.Sheets(1).Range("A1:I50") 
    ' .Select 
    ' .Copy 
    ' .PasteSpecial xlPasteValues 
    'End With 
    'Application.CutCopyMode = False 

    'Save the new workbook/Mail it/Delete it 
    TempFilePath = Environ$("temp") & "\" 
    TempFileName = "Part of " & Sourcewb.Name & " " _ 
       & Format(Now, "dd-mmm-yy h-mm-ss") 


    Set NewMail = CreateObject("CDO.Message") 

    ' Define Gmail configuration 
    NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True    ' Enalbe SSL 
    NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1   ' SMTP Authentication ON 
    NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Gmail_SMTP   ' SMTP Server address 
    NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25    ' SMTP port 
    NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2     ' SMTP encryption 
    NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Gmail_ID   ' Gmail ID 
    NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Gmail_PWD  ' Gmail PWD 
    NewMail.Configuration.Fields.Update                     ' Update all settings 

    With Destwb 
     .SaveAs TempFilePath & TempFileName & FileExtStr, _ 
       FileFormat:=FileFormatNum 
     .Close savechanges:=False 
     On Error Resume Next 

     Gmail_attachment = TempFilePath & TempFileName & FileExtStr 

     'Set All Email Properties 
     With NewMail 
      .From = Gmail_ID 
      .To = SendTo 
      .CC = SendCC 
      .BCC = "" 
      .Subject = Holidex & " System Login - " & ThisWorkbook.Name & " - " & Format(Now, "dd-mm-yyyy") 
      .textbody = "The following client has just logged in to this system:" & vbNewLine _ 
       & "Date: " & Format(Now, "dd-mm-yyyy hh:ss") & vbNewLine _ 
       & "System: F&B Feedback Card Summary" & vbNewLine _ 
       & "Filename: " & ThisWorkbook.FullName 

      '.HTMLBody = "Write your complete HTML Page" 

     ' For multiple Attachment you can add below lines as many times 
      .AddAttachment Gmail_attachment 
     End With 

     NewMail.Send ' or use .display 
     'MsgBox Gmail_attachment, vbOKOnly, "String" 
    End With 

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

    ' Delete the duplicated worksheet and turn off prompts 
    Application.DisplayAlerts = False 
     With ActiveWorkbook 
      .ActiveSheet.Select 
      .ActiveSheet.Delete 
      .Sheets("Summary").Select 
     End With 
    Application.DisplayAlerts = True 

    ' Clean up 
     Set NewMail = Nothing 

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

End Sub 

問題は1が.attachment「C：\のfile.xls」が追加されます。このセクションではここにあるので、私は配置しなければならなかった、スクリプトが開いているブックを取り付けるサポートしていない変数

'Set All Email Properties 
With NewMail 
    .From = Gmail_ID 
    .To = SendTo 
    .CC = SendCC 
    .BCC = "" 
    .Subject = Holidex & " System Login - " & ThisWorkbook.Name & " - " & Format(Now, "dd-mm-yyyy") 
    .textbody = "The following client has just logged in to this system:" & vbNewLine _ 
     & "Date: " & Format(Now, "dd-mm-yyyy hh:ss") & vbNewLine _ 
     & "System: F&B Feedback Card Summary" & vbNewLine _ 
     & "Filename: " & ThisWorkbook.FullName 

    '.HTMLBody = "Write your complete HTML Page" 

' For multiple Attachment you can add below lines as many times 
    .AddAttachment Gmail_attachment 
End With 

Answer 1

を問題を解決した保存ダイアログの直後に.Close savechanges:=Falseを追加してください。オリジナルの投稿が編集されました。