Thema: Per Kopfdruck als pdf speichern und Mail erstellen

Hallo zusammen,

ich würde nun gerne das aktuelle Blatt per Knopfdruck als pdf speichern und dann per Mail versenden.

Betreff und Empfänger (mehrere) dabei gerne in einer Zelle vorgegeben und somit variabel. Umstellen nach nicht variabel würde ich mir im Fall der Fälle zutrauen. ;)

Für den Speichernamen gerne eine Messagebox in der dieser abgefragt wird.

Hallöchen,

https://www.bing.com/search?q=excel+vba+email+pdf&form=ANNTH1&refig=f46c5edde8894118904c9e5e1e10f793&pc=W035

Ich habe mal die Chatgpt genommen. Dabei kommt das unten ersichtliche raus, was schon sehr gut klappt.

Wie kann umbauen, damit der Name auch schon fest eingegeben ist? Ich dachte erst einfach Namen durch array ersetzen und oben einfach Dim name As String zu Dim name As Variant ändern. Klappt aber nicht.:

' Namen abfragen
name = InputBox("Bitte geben Sie den Namen des Empfängers ein:", "Name eingeben")

' E-Mail-Adressen
emailAddresses = Array("xxx@xxx.com")

Hier das Makro:

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

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

Hallöchen,
Definiere die Adressen als String und nicht als Array. Die beiden setzt du dann mit Semikolon getrennt zusammen.
Im Prinzip Email=Email1 & ";" & Email2

Ein Array bilden geht etwas anders...

habe ich versucht, aber dann bekomme ich in dem Bereich die Fehlermeldung: "erwartet Datenfeld"

' E-Mails senden

    For i = LBound(emailAddresses) To UBound(emailAddresses)

 Dim emailAddresses As String

    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 = "joerg.bergmann@sanha.com"

Hallo ,

abschließend interessehalber hier noch ein Statement zu Deiner Anforderung.

zur Erklärung:

Du kannst so ein Array erstellen, um mehrere eMails nacheinander zu versenden
emailAddresses = Array("joerg.bergmann@sanha.com","Hein.Bloed@sanha.com")

oder auch ein Array aus einem String erstellen

DIM emailAddresses() as string
emailAddresses =Split("joerg.bergmann@sanha.com;Hein.Bloed@sanha.com",";")


Und anschließend die Versendung des Array in einer Schleife bewerkstelligen.
' E-Mails senden
For i = LBound(emailAddresses) To UBound(emailAddresses)
SendMailWithAttachment name, emailAddresses(i), folderPath & fileName
Next i


Wenn Du Deine Adressen oder auch nur eine Adresse in einer Variablen bzw. Feld semikolongetrennt hast, kannst Du mit einer eMail alle Adressaten erreichen.
DIM emailAddresses as string
emailAddresses = "joerg.bergmann@sanha.com;Hein.Bloed@sanha.com"
Bei einer Variablen kannt Du aber nicht die Schleife nutzen, denn die möchte ja ein Array bzw. Datenfeld dafür hernehmen. Daher bekommst Du auch die Fehlermeldung.

Da Du die Inputbox nutzt, um einen Namen abzufragen, willst Du wahrscheinlich nur eine Mail versenden. Da fallen also Array und Schleife weg. Ein Name bei mehreren eMail-Empfängern macht ja auch wenig Sinn.

Ich würde es einfach so oder so ähnlich machen...

Code:


Sub PDFSpeichernUndVersenden()
  Dim folderPath As String
  Dim fileName As String
  Dim sName As String, sEmpfaenger As String

' 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
  sName = InputBox("Bitte geben Sie den Namen des Empfängers ein:", "Name eingeben")
  sEmpfaenger = "joerg.bergmann@sanha.com"

 ' eMail erstellen
  With CreateObject("Outlook.Application").CreateItem(0)
      .GetInspector.Display
      .To = sEmpfaenger
      .Subject = "Rückstellungsspiegel SUK"
      .body = "Hallo " & sName & "," & vbCr & vbCr _
            & "anbei der Rückstellungsspiegel der SUK." & vbCr & vbCr _
            & "Viele Grüße" & vbCr & "Jörg" & vbCr & .body
      If Dir$(folderPath & fileName) <> "" Then
         .Attachments.Add folderPath & fileName
      End If
'     .Send
  End With

End Sub