excel tabelle als pdf speichern und per outlook versenden

[andi61]

Hallo zusammen,

bin etwas ratlos.
Ich habe ein Formular als Excel-Tabelle, welches ich bei Druck auf den "Abschicken"-Button zunachst unter D: speichern möchte und dann an eine festgelegt E-Mail-Adresse versenden möchte.
DAS GANZE HATTE BEREITS SCHON FUNKTIONIERT!
Nun wollte ich es heute anwenden und bekomme jetzt einen Laufzeit-Fehler. Der Debugger "meckert" die unten rot geschriebenen Zeilen an. Wäre sehr dankbar, wenn mir jemand helfen könnte.

Gruß Andi

Hier der Code:


Sub sendmail()

  Dim sBlatt As String
  Dim sPdfDateiF5 As String
  Dim OutApp As Object
  Dim OutMail As Object

 
  ' speichern unter als PDF:
  sPdfDateiF5 = "D:" & "KFZ-Anforderung" & ".PDF"
 
  ' speichert das aktuelle Blatt (=ActiveSheet) als PDF
  ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=sPdfDateiF5, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

 
  ' Bezug zu Outlook herstellen...
  Set OutApp = CreateObject("Outlook.Application")

  ' ...neue E-Mail erzeugen
  Set OutMail = OutApp.CreateItem(0)

  ' Werte den Eigenschaften zuweisen...
  OutMail.To = "name@provider.de"
  OutMail.CC = ""
  OutMail.BCC = ""
  OutMail.Subject = "KFZ-Anforderung"
  OutMail.Body = ""

  ' Anhang hinzufügen:
  OutMail.Attachments.Add sPdfDateiF5
 
  ' ...und abschicken
  OutMail.Send

  ' Objekte sauber auflösen
  Set OutMail = Nothing
  Set OutApp = Nothing
 
  ' Tabelle schließen
  Application.DisplayAlerts = False
  Application.Quit

End Sub

[Kuwer]

Hallo Andi,

da fehlt doch der Backslash (jetzt rot gekennzeichnet)?

 ' speichern unter als PDF:
 sPdfDateiF5 = "D:\KFZ-Anforderung.PDF"

Gruß Uwe

[andi61]

Hallo Kuwer,

danke. Es funktioniert jetz.

Nun möchte ich aber nach anklicken des Ausühr-Buttons noch eine Abfrage einbauen -MsgBox -ja = ausführen, nein = abbrechen und Tabelle schließen (ohne pdf erzeugen und versenden).
Ich habe schon etwas in den Code reingeschrieben, aber das geht so nicht. Kann jemand helfen?
Gruß Andi

Sub sendmail()

  Dim sBlatt As String
  Dim sPdfDateiF5 As String
  Dim OutApp As Object
  Dim OutMail As Object
  Dim Antwort

 Antwort = MsgBox("Möchten Sie die Anforderung abschicken?", 4, "Frage")
    If Antwort = vbYes Then
    If Antwort = vbNo Then Application.Quit
    End If
    
  ' speichern unter als PDF:
  sPdfDateiF5 = "D:\KFZ-Anforderung.PDF"
 
  ' speichert das aktuelle Blatt (=ActiveSheet) als PDF
  ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=sPdfDateiF5, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

    
  ' Bezug zu Outlook herstellen...
  Set OutApp = CreateObject("Outlook.Application")

  ' ...neue E-Mail erzeugen
  Set OutMail = OutApp.CreateItem(0)

  ' Werte den Eigenschaften zuweisen...
  OutMail.to = "name@provider.de"
  OutMail.CC = ""
  OutMail.BCC = ""
  OutMail.Subject = "KFZ-Anforderung"
  OutMail.Body = ""

  ' Anhang hinzufügen:
  OutMail.Attachments.Add sPdfDateiF5
 
  ' ...und abschicken
  OutMail.Send

  ' Objekte sauber auflösen
  Set OutMail = Nothing
  Set OutApp = Nothing
 
  ' Tabelle schließen
  Application.DisplayAlerts = False
  Application.Quit
 
End Sub

[Kuwer]

Hallo Andi,

mit Abfrage und sauberem Schließen:

Option Explicit

Sub SendeMail()

 Dim sBlatt As String
 Dim sPdfDateiF5 As String
 Dim OutApp As Object
 Dim OutMail As Object

 If MsgBox("Möchten Sie die Anforderung abschicken?", 4, "Frage") = vbYes Then
   
   ' speichern unter als PDF:
   sPdfDateiF5 = "D:\KFZ-Anforderung.PDF"
  
   ' speichert das aktuelle Blatt (=ActiveSheet) als PDF
   ActiveSheet.ExportAsFixedFormat _
     Type:=xlTypePDF, _
     Filename:=sPdfDateiF5, _
     Quality:=xlQualityStandard, _
     IncludeDocProperties:=True, _
     IgnorePrintAreas:=False, _
     OpenAfterPublish:=False
     
   ' Bezug zu Outlook herstellen...
   Set OutApp = CreateObject("Outlook.Application")

   ' ...neue E-Mail erzeugen
   Set OutMail = OutApp.CreateItem(0)

   ' Werte den Eigenschaften zuweisen...
   OutMail.to = "name@provider.de" 'richtige Email-Adresse angeben
   OutMail.CC = ""
   OutMail.BCC = ""
   OutMail.Subject = "KFZ-Anforderung"
   OutMail.Body = ""

   ' Anhang hinzufügen:
   OutMail.Attachments.Add sPdfDateiF5

   ' ...und abschicken
   OutMail.Send

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

 ' Abfrage ob Mappe nicht die einzige offene sichtbare Mappe ist
 If IchBinNichtAllein(ThisWorkbook) Then
   ' Mappe schließen
   ThisWorkbook.Close False
 Else
   ' Mappe als gespeichert kennzeichnen
   ThisWorkbook.Saved = True
   ' Excel schließen
   Application.Quit
 End If
End Sub

' Funktion gibt WAHR/True zurück,
' wenn die Mappe nicht die einzige offene sichtbare Mappe ist
Function IchBinNichtAllein(Ich As Workbook) As Boolean
 Dim oWb As Workbook
 For Each oWb In Workbooks
   If oWb.Windows(1).Visible And oWb.Name <> Ich.Name Then
     IchBinNichtAllein = True
     Exit For
   End If
 Next oWb
End Function

Code eingefügt mit: Excel Code Jeanie

Wegen des Schließens siehe hier: Excel Schließen wenn kein anderes dokument geöffnet ist.

Gruß Uwe