Я его отредактировал, кажется, работает, но может быть сокращено.
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