时间戳

首页 > 解决方案 > 当我尝试在 Outlook 中发送 excel 时，vba 代码错误 400

vba - 当我尝试在 Outlook 中发送 excel 时，vba 代码错误 400

问题描述

因此，当我尝试运行此代码以发送我的 excel 并在 Outlook 中附加 pdf 时，我遇到了错误 400。不太确定这里出了什么问题，希望能得到一些帮助。谢谢

在下面包括我的代码：

Sub Send_Doc()
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Set Sourcewb = ActiveWorkbook
    'Copy the sheet to a new workbook
    Sheets("xxxx").Copy
    Set Destwb = ActiveWorkbook
    Range("A4:Z10").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Daily xxx"
    Range("A4:Z10").Select
    Selection.CopyPicture xlScreen, xlBitmap
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With Destwb
        .SaveAs TempFilePath & TempFileName & ".pdf"
        On Error Resume Next
        With OutMail
            .To = "xxxx@xxx.com; xxx2@xxx.com"
            .CC = "xxxx3@xxx.com; xxx4@xxx.com"
            .BCC = ""
            .Subject = "Daily xxx " & Format(Now(), "dd mmm yy")
            OutMail.GetInspector.WordEditor.Range.Paste
            .Attachments.Add Destwb.FullName
            .display
        End With
    'OutMail.display
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    'Delete the file you have send
    'Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

标签： vbaoutlook

解决方案

我已经对其进行了编辑，似乎可以工作，但可以缩短。

Sub SendFxPosition()

    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range

    Set Sourcewb = ActiveWorkbook

    'ADD THIS:
    ' Select range from B instead of A so that you can type Dear Sir.... in Cell A
    Sheets("SHEET1").Range("B4:U32").ExportAsFixedFormat Type:=xlTypePDF, _
      Filename:="C:\Users\xxx\Downloads\test\DOCUMENT1.pdf", _
       Quality:= xlQualityStandard, IncludeDocProperties:=True, _
       IgnorePrintAreas:=False, OpenAfterPublish:=False
    'END

    'Copy the sheet to a new workbook:
    ' Copy from A so that when you paste into outlook you will have Dear Sir....
    Sheets("SHEET1").Copy
    Set Destwb = ActiveWorkbook

    Range("A4:U32").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'If Temp file doesn't work for you,
    ' you can use a designated folder like the one below
    TempFilePath = "C:\Users\xxxx\Downloads\test\"
    TempFileName = "DOCUMENT1"

    Range("A4:U32").Select
    Selection.Copy

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        OutMail.GetInspector.WordEditor.Range.PasteSpecial xlPasteValuesAndNumberFormats
    End With

    With Destwb
        .SaveAs TempFilePath & TempFileName & ".xls"
        On Error Resume Next
        With OutMail         
            .To = "xxxx@xxx.com; xxxx2@xxx.com"
            .CC = ""
            .BCC = ""
            .Subject = "Daily XXX " & Format(Now(), "dd mmm yy")

            OutMail.GetInspector.WordEditor.Range.Paste

            'ADD THIS
            DestwbPDF = "C:\Users\xxxx\Downloads\test\DOCUMENT1.pdf"
            .Attachments.Add DestwbPDF
            'END           

            .display
        End With

        'OutMail.display
         On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    'Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

推荐阅读