|
Hallo,
hier noch ein Versuch, wenn ich alles richtig verstanden habe, ohne Bereichskopie.
Zur Unterdrückung der Zugriffsabfrage kann ich Dir leider keine Abhilfe empfehlen.
Und Du musst natürlich das Tabelenblatt mit den entsprechenden daten anpassen, sonst kommt da natürlich nichts.
Option Explicit
Sub Mail_Senden_mit_PDF()
'Sendet Mail mit integriertem Bereich als Bild mit Signatur
'Das Bild wird über das Kürzel ~ im Text platziert
Dim WSh As Worksheet
Dim sMailtext As String, sSignatur As String
Dim sDateiName As String, T As String
'<<<Tabellenblatt anpassen>>>
Set WSh = ThisWorkbook.Sheets("Tabelle1") 'Blatt mit Maildaten
sDateiName = ThisWorkbook.FullName
sDateiName = Left$(sDateiName, InStrRev(sDateiName, ".")) & "pdf"
T = ThisWorkbook.Path & "\"
sDateiName = Replace(sDateiName, T, T & WSh.Range("B4").Value & "_")
'<<<Tabellenblatt anpassen>>>
ThisWorkbook.Sheets("Furnierte Platten").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sDateiName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2 'HTML-Format, Angabe optional
.Subject = "Bestellung " & WSh.Range("B4").Value 'Betreff
.To = Replace(WSh.Range("E9").Value, vbLf, ";") 'Empfänger
sMailtext = "Guten Tag," & vbLf & vbLf & "Im Anhang sende ich Ihnen die Bestellung für Auftrag " _
& WSh.Range("B4").Value & "." & vbLf & "Gerne erwarte ich Ihre Bestätigung." & vbLf
.GetInspector: sSignatur = .HTMLBody 'Signatur holen
.HTMLBody = Replace(sMailtext, vbLf, "<br>") & sSignatur
.Display
'Anlage anfügen
If Dir$(sDateiName) <> "" Then
.Attachments.Add sDateiName 'Anlage anfügen
End If
End With
End Sub
Viel Erfolg und viele Grüße
Karl-Heinz
|