Hallo,

ich habe kaum VBA Erfahrung aber es irgenwie geschafft ein Tool zu erstellen mit dem ich Exellisten verteilen und per Mail als PDF versenden kann. Auch wenn es einfacher klingt habe ich keine Ahnung wie ich anstelle von PDF einzelne xlsx Dateien per Mail versende. Immer wenn ich meinen Code umschreibe laufe ich auf Error. Ich denke es ist einfach aber benötige Hilfe. Der nachfolgende Code zur Erstellung der PDF muss anstelle der PDF XLSX erstellen. Den restlichen Code habe ich nur teilweise kopiert da ich mir sicher bin das eigentlich nur die rot gekennzeichnetten Stellen"geändert" werden müssen.

Function SendMail(EMailTo As String, MailSubject As String) As Boolean

  Static CurrentNumber As Integer
  CurrentNumber = CurrentNumber + 1

  Dim SheetNameConfiguration As String
  SheetNameConfiguration = "Konfiguration"
    
  Dim PathPDFFiles As String
  PathPDFFiles = Sheets(SheetNameConfiguration).Range("B2").Value & IIf(Right(Sheets(SheetNameConfiguration).Range("B2").Value, 1) = "\", "", "\")
    
  Dim sPdfDatei As String
  Dim OutApp As Object
  Dim OutMail As Object

  On Error GoTo ErrorHandler
  
  ' unter welchem Namen sollen die PDF-Dateien abgespeichert werden?
  sPdfDatei = PathPDFFiles & "Diasauswertungen " & Format(Now, "dd.mm.yyyy hh_nn_ss") & " " & CurrentNumber & ".pdf"

  ' speichert das aktuelle Blatt (=ActiveSheet) als PDF
    ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=sPdfDatei, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

  FileCopy sPdfDatei, PathPDFFiles & "Diasauswertungen.pdf"
  
  ' Bezug zu Outlook herstellen...
  Set OutApp = CreateObject("Outlook.Application")

  ' ...damit wir eine neue E-Mail erzeugen können
  Set OutMail = OutApp.CreateItem(0)

  ' Werte den Eigenschaften zuweisen...
  OutMail.To = EMailTo
  OutMail.CC = ""
  OutMail.BCC = ""
  OutMail.Subject = "SQL: " & MailSubject
  OutMail.Body = "Guten Tag," & vbNewLine & _
                vbNewLine & _
                "für Sie zur Bearbeitung." & vbNewLine & _
                vbNewLine & _
                "Mit freundlichem Gruß." & vbNewLine & _
                vbNewLine & _
                vbNewLine & _
                vbNewLine & _
                "Bei Fragen, bitte Absender kontaktieren." & vbNewLine & vbNewLine

  ' Anhang hinzufügen: Welchen? Dann also beide Dateien!
  OutMail.Attachments.Add PathPDFFiles & "Diasauswertungen.pdf"

  ' ...und abschicken
  OutMail.Send

  ' Objekte sauber auflösen
  Set OutMail = Nothing
  Set OutApp = Nothing

  Kill PathPDFFiles & "Diasauswertungen.pdf"
  SendMail = True
  Exit Function

ErrorHandler:
   If Len(Dir(PathPDFFiles & "Diasauswertungen.pdf")) > 0 Then
      Kill PathPDFFiles & "Diassauswertungen.pdf"
   End If
  
  SendMail = False

End Function