Я пытаюсь скопировать диапазон ячеек (excel) и PasteSpecial (как изображение) в тело письма, используя Outlook vba , я много искал решение, но всегда нахожу, как это сделать что с использованием excel vba. Любая помощь будет принята с благодарностью, спасибо.
код Outlook vba
Sub projet()
Dim olMailItem As Outlook.MailItem
Dim olMailItem1 As Outlook.MailItem
Dim xExcelFile As String
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xWs As Excel.Worksheet
' path of the excel file
xExcelFile = "C:\Users\user\Desktop\Maquette.xlsx"
' check if the excel file is open or not
If IsWorkBookOpen(xExcelFile) = True Then
Set xExcelApp = GetObject(, "Excel.Application")
Set xlWB = GetObject(xExcelFile)
If Not xlWB Is Nothing Then xlWB.Close True
Else
Set xExcelApp = New Excel.Application
End If
Set xlWB = xExcelApp.Workbooks.Open(xExcelFile)
Set xWs = xlWB.Sheets(1)
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem3)
With xlWB.Worksheets(4).Range("A1:C6").Copy
OutlookMail.Display
OutlookMail.To = "xxx"
OutlookMail.CC = "xxx"
OutlookMail.Subject = "Rapport de supervision : nuit du " &
Format(Date- 1, "dd/mm/yyyy") & " au " & Format(Date, "dd/mm/yyyy")
OutlookMail.Body = xlWB.Worksheets(4).Range("A1:C6").Paste
End With
xlWB.Save
xlWB.Close
End Sub
Function IsWorkBookOpen(FileName As String)
Dim xFreeFile As Long, xErrNo As Long
On Error Resume Next
xFreeFile = FreeFile()
Open FileName For Input Lock Read As #xFreeFile
Close xFreeFile
xErrNo = Err
On Error GoTo 0
Select Case xErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error xErrNo
End Select
End Function