使用Excel VBA将文件附加到电子邮件

时间:2019-08-19 16:19:24

标签: excel vba

我试图将工作簿中的两个工作表作为单独的文件保存到公司网络位置,然后将这些文件附加到电子邮件中。

Sub Test_Module_Peter()
'
Dim OutApp As Object
Dim OutMail As Object
Dim SPpath As String
Dim SCpath As String
Dim SPfilename As String
Dim SCfilename As String
Dim SPFullFilePath As String
Dim SCFullFilePath As String
Dim wb As Workbook
Dim Cell As Range

Application.ScreenUpdating = False

' export a copy of PER SP Form
    Sheets("PER SP").Select
    Sheets("PER SP").Copy

' Remove formulas from SP sheet
    With ActiveSheet.UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
    Application.CutCopyMode = False

' Save a copy of the SP PER Form
    SPpath = "\\UKRLTD008\Company\...\...\...\2019\"
    SPfilename = "TEST - PER SP ABL90_2019 " & Range("M1")
    SPFullFilePath = SPpath & SPfilename
    ActiveWorkbook.SaveAs filename:=SPpath & SPfilename, FileFormat:=52
    ActiveWorkbook.Close SaveChanges = True

' select ABL90 Credit Claim Master Spreadsheet
    For Each wb In Application.Workbooks
        If wb.Name Like "ABL90 Credit Claim Master*" Then
            wb.Activate
        End If
    Next

' export a copy of PER SC Form
    Sheets("PER SC").Select
    Sheets("PER SC").Copy

' Remove formulas from SC sheet
    With ActiveSheet.UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
    Application.CutCopyMode = False

' Save a copy of the SC PER Form
    SCpath = "\\UKRLTD008\Company\...\...\...\2019\"
    SCfilename = "TEST - PER SC ABL90_2019 " & Range("M1")
    SCFullFilePath = SCpath & SCfilename
       ActiveWorkbook.SaveAs filename:=SCpath & SCfilename, FileFormat:=52
       ActiveWorkbook.Close SaveChanges = True

' Send the SP PER Form to RMED
   Set OutApp = CreateObject("Outlook.Application")
   Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .SentOnBehalfOfName = "sales@radiometer.co.uk"
        .To = "laura.valenti@radiometer.co.uk"
        .CC = ""
        .BCC = ""
        .Subject = "RLTD PER Forms " & Range("M1")
        .Body = "Hi " & vbNewLine & vbNewLine & "Please find attached ABL90 PER's" & vbNewLine & vbNewLine & "Thank you"
        .Attachments.Add SPFullFilePath
        .Attachments.Add SCFullFilePath
        .Display
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

它保存文件,但是当我尝试将它们作为附件添加到电子邮件时,会发生以下错误:

  

运行时错误'-2147024894(80070002)':找不到此文件。确认路径和文件名正确。

我试图将每个文件的路径和文件名一起保存为FullFilePath,但似乎不起作用,有人可以告诉我为什么吗?

0 个答案:

没有答案