我遵循本教程通过Gmail SMTP发送电子邮件，它运行良好，但在添加附件时失败。
http://www.learnexcelmacro.com/wp/2011/12/how-to-send-an-email-using-excel-macro-from-gmail-or-yahoo/
我正在尝试发送活动工作簿的副本，该副本已保存到用户TEMP Appdata文件夹中。我跟踪了临时文件，检查了文件是否存在，这是可以的，应该不会有问题，但是，excel似乎没有附加它。但是，如果我硬编码它，我可以附加文件（例如"C:\temp\file.xls"），但当文件路径通过变量给定时，则不能。
有人能给我指正确的方向吗？我没主意了。。。
编辑：为了澄清，我尝试了几种语法，例如在Gmail_Attachment变量中定义路径或添加TempFilePath&TempFileName&FileExtStr变量。它们都不起作用，只有当我把它编码为.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
问题就在本节中，其中添加了.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
脚本不支持附加打开的工作簿，因此我不得不将.Close savechanges:=False放在保存对话框之后，这解决了问题。原始帖子已被编辑。