Clever-Excel-Forum

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

Hallo Andi,

da fehlt doch der Backslash (jetzt rot gekennzeichnet)?

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

Gruß Uwe

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

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