Vba 我的例行程序不会将文件附加到我指定的电子邮件中
我有一个例程,将文件作为值保存到excel和pdf中,然后通过电子邮件将文件发送到distlist,但由于某些原因,它不会附加我指定的文件..非常感谢任何帮助..我将VBA代码放在下面Vba 我的例行程序不会将文件附加到我指定的电子邮件中,vba,excel,Vba,Excel,我有一个例程,将文件作为值保存到excel和pdf中,然后通过电子邮件将文件发送到distlist,但由于某些原因,它不会附加我指定的文件..非常感谢任何帮助..我将VBA代码放在下面 Sub SaveFile() 'Recalc Sheets prior to saving down a = MsgBox("Do you want to Save the Performance Reports?", vbOKCancel) If a = 2 Then Exit Sub Dim SaveSh
Sub SaveFile()
'Recalc Sheets prior to saving down
a = MsgBox("Do you want to Save the Performance Reports?", vbOKCancel)
If a = 2 Then Exit Sub
Dim SaveSheets As Variant
Dim strFilename As String
Dim sheetListRange As Range
Dim sheetName As Variant
Dim wksheet As Variant
Dim wkbSrc As Workbook
Dim wkbNew As Workbook
Dim wksNew As Worksheet
Dim wksSrc As Worksheet
Dim i As Integer
Dim OutApp As Object
Dim OutMail As Object
'Dim v As Variant
'On Error GoTo ErrorHandler
strFilename = Worksheets("Control").Range("SavePath").Value & "Ergonomie_Consultants_Performance_" & Format$(Now(), "YYYYMMDD") & ""
v = strFilename
Set sheetListRange = Worksheets("Control").Range("SaveList")
Set wkbSrc = ActiveWorkbook
Set wkbNew = Workbooks.Add
i = 0
For Each sheetName In sheetListRange
If sheetName = "" Then GoTo NEXT_SHEET
For Each wksheet In wkbSrc.Sheets
If wksheet.Name = sheetName Then
i = i + 1
wksheet.Copy Before:=wkbNew.Sheets(i)
Set wksNew = ActiveSheet
With wksNew
.Cells.Select
.Cells.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
End With
ActiveWindow.Zoom = 75
GoTo NEXT_SHEET
End If
Next wksheet
NEXT_SHEET:
Next sheetName
Application.DisplayAlerts = False
'dont need the default new sheets created by created a new workbook
wkbNew.Worksheets("Sheet1").Delete
'ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlsm
ActiveWorkbook.SaveAs FileName:=v, FileFormat:=xlNormal
' ActiveWorkbook.SaveAs FileName:=v, FileFormat:=xlNormal
' ActiveWorkbook.SaveAs FileName:=strFilename, FileFormat:=xlTypePDF
' If VarType(v) <> vbString Then Exit Sub
'
' If Dir(v) <> "" Then
' If MsgBox("File already exists - do you wish to overwrite it?", vbYesNo, "File Exists") = vbNo Then Exit Sub
' End If
With ActiveWorkbook
.ExportAsFixedFormat Type:=xlTypePDF, FileName:=v, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=False
End With
ActiveWorkbook.Close
' EMAIL Excel Attachment File
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "waverley.inc@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Ergonomie Australia Pty Ltd Consultant Report" & Format$(Now(), "_YYYYMMDD")
.Body = "Ergonomie Australia Pty Ltd Consultant Report" & Format$(Now(), "_YYYYMMDD")
'
.Attachments.Add v
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
Exit Sub
ErrorHandler:
'If there is an unknown runtime error give the user the error number and associated description
'(Description is already set if the erorr is G_LNG_CRITICAL_ERROR)
If Err.Number <> CRITICAL_ERROR Then Err.Description = "Run-time error " & Err.Number & ": " & Err.Description
Err.Description = "Error saving worksheet as file: " & Err.Description
Err.Source = "Error saving worksheet as file: " & Err.Source
'Raise the error up to the error handler above
Err.Raise Number:=CRITICAL_ERROR
End Sub
由于变量v中缺少文件扩展名,因此未附加文件,因此系统无法找到该文件 只需添加文件扩展名:
.Attachments.Add v & ".pdf"
由于变量v中缺少文件扩展名,因此未附加文件,因此系统无法找到该文件 只需添加文件扩展名:
.Attachments.Add v & ".pdf"