AW: Per Kopfdruck als pdf speichern und Mail erstellen
19.04.2024 16:15:31
Jörg Bergmann
Sub PDFSpeichernUndVersenden()
Dim folderPath As String
Dim fileName As String
Dim name As String
Dim emailAddresses As Variant
Dim i As Integer
' Festlegen des Speicherorts
folderPath = "W:\"
' PDF speichern
fileName = "Rückstellungsspiegel SUK.pdf"
ThisWorkbook.Sheets("Übersicht").ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
folderPath & fileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
' Namen abfragen
name = InputBox("Bitte geben Sie den Namen des Empfängers ein:", "Name eingeben")
' E-Mail-Adressen
emailAddresses = Array("joerg.bergmann@sanha.com")
' E-Mails senden
For i = LBound(emailAddresses) To UBound(emailAddresses)
SendMailWithAttachment name, emailAddresses(i), folderPath & fileName
Next i
End Sub
Sub SendMailWithAttachment(ByVal name As String, ByVal email As String, ByVal attachmentPath As String)
Dim outlookApp As Object
Dim outlookMail As Object
' Outlook-Instanz erstellen
Set outlookApp = CreateObject("Outlook.Application")
Set outlookMail = outlookApp.CreateItem(0)
' E-Mail-Eigenschaften festlegen
With outlookMail
.To = email
.Subject = "Rückstellungsspiegel SUK"
.Body = "Hallo " & name & "," & vbCr & vbCr & "anbei der Rückstellungsspiegel der SUK." & vbCr & vbCr & "Viele Grüße" & vbCr & "Jörg"
.Attachments.Add attachmentPath
.Send
End With
' Freigeben von Ressourcen
Set outlookMail = Nothing
Set outlookApp = Nothing
End Sub