附加PDF以便在Excel中发送电子邮件,每次运行宏时都会更改

时间:2017-07-31 14:22:18

标签: excel vba excel-vba

我有一个宏从工作簿中复制一些工作表,然后通过电子邮件发送它。

我可以将其保存为设置文件名并使用它但是我也想保留PDF的文件名。

基本上是宏

  • 复印2张
  • 将其保存为与E1相关的文件名,并将其保存为PDF格式。
  • 打开Outlook并尝试通过电子邮件发送两个已保存的文件。

它附加了活动的书籍,但是我无法使用相同的名称附加PDF。我可以将它保存为Revisit.pdf并且附加正常,但是我需要更改文件名。

任何想法都会被感激不尽。

这是我目前的代码:

Sub EmailWithOutlook()
    Dim oApp As Object
    Dim oMail As Object
    Dim WB As Workbook
    Dim FileName As String
    Dim wSht As Worksheet
    Dim shtName As String

    Application.ScreenUpdating = False

    'Delete all PDF fies in P:\field service\JJohns\FOF Data\TEMP
    Call killPDF

    Call Firstentry


    ' Sheets("Daily Sheets").Select
    ' activeSheet.Copy
    ' ActiveWorkbook.SaveAs "P:\Field Service\JJohns\Engineer Revisits\" & Range("E1").Value

    Sheets("Dashboard").Select
    Sheets("Dashboard").Name = "Dashboard"
    Sheets(Array("Dashboard", "Daily Sheets")).Select
    Sheets("Daily Sheets").Activate
    Sheets(Array("Dashboard", "Daily Sheets")).Copy
    Sheets("Daily Sheets").Select
    Sheets("Dashboard").Select
    ActiveSheet.Shapes.Range(Array("Team Leader")).Select
    Selection.Cut
    ActiveSheet.Shapes.Range(Array("Date of update")).Select
    Selection.Cut
    Range("E1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("E1").Select

    ActiveWorkbook.SaveAs "P:\Field Service\JJohns\Engineer Revisits\" & Range("E1").Value

    'Save PDF VERSION

    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
        "P:\Field Service\JJohns\FOF data\TEMP\" & Range("E1").Value, Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

    ' SAVE PDF AS REVISITS
      '  ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
   '     "P:\Field Service\JJohns\FOF Data\Temp\Revisits.pdf", Quality:=xlQualityStandard _
    '    , IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _
     '   :=False
    ' Application.Dialogs(xlDialogSendMail).Show


    'Create and show the Outlook mail item
    Set App = CreateObject("Outlook.Application")
    Set Mail = App.CreateItem(0)
    With Mail
        'Uncomment the line below to hard code a recipient
         .To = "XXXXXXXXX"
        ' .CC = "XXXXXXXXXX"
        'Uncomment the line below to hard code a subject
        .Subject = Range("Dashboard!E1").Value
        'Uncomment the lines below to hard code a body
        ' .body = "Hi Mark" & vbCrLf & vbCrLf & _
        '   "Please find attached the North East updates"
        .Attachments.Add ActiveWorkbook.FullName
        **.Attachments.Add "P:\Field Service\JJohns\FOF Data\Temp\" & Range(E1).Value, .PDF**
        .Display
    End With

    'Delete the temporary file
    ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
    Kill ActiveWorkbook.FullName
    ActiveWorkbook.Close SaveChanges:=False

    'Restore screen updating and release Outlook
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
End Sub

1 个答案:

答案 0 :(得分:0)

尝试这样

 'Save PDF VERSION
 Dim s as string
 s =  "P:\Field Service\JJohns\FOF data\TEMP\" & Range("E1").Value & ".pdf"
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
    s, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

 'more code here

 .Attachments.Add s

此外,我假设您在错误时检查该文件是否存在于该位置?