Question

我有一个例程，将文件作为值保存到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 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

Answer 1

由于变量v中缺少文件扩展名，因此未附加文件，因此系统无法找到该文件。

只需添加文件扩展名：

    .Attachments.Add v & ".pdf"

我的例行程序不会将文件附加到我指定的电子邮件中

1 个答案: