Blatt als PDF speichern und mailen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Blatt als PDF speichern und mailen
von: Sabrina
Geschrieben am: 29.11.2015 16:25:28

Hallo Leute, ich nutzt immer noch Excel 2003. Und da gibt es die REM Funktion nicht :(
Ich möchte ein Tabellenblatt als PDF speichern.
Der Name der Datei soll der Inhalt der Zelle "Nummer" sein.
Am liebsten soll die Datei dann noch gemailt werden, an die Mailadresse aus der Zelle mit dem Namen "Mail"
Ich habe schon ein wenig gegeoogelt. Aber damit wird eine .PS Datei gespeichert.
Wenn ich die Stelle in .pdf ändere ist die Datei nicht zu öffnen da defekt.
LG
Sabbel

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Sub Mail()
    Const cstrCreator = "D:\PDFCreator\pdfcreator.exe"
    Dim strPDFPath As String
     
    strPDFPath = "D:\Test.pdf"
     
    ActiveSheet.PrintOut ActivePrinter:="PDFCreator", PrintToFile:=True, PrToFileName:="D:\test. _
 _
ps"
    Sleep 2000
    Shell cstrCreator & " /IF""D:\Test.ps"" /OF""" & strPDFPath & """ /DeleteIF"
 End Sub

Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sepp
Geschrieben am: 29.11.2015 16:47:52
Hallo Sabrina,
ungetestet, eil PDFCreator nicht vorhanden!

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Sub PrintToPDF_Late()
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for late bind, no references req'd
Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String

'/// Change the output file name here! ///
sPDFName = "Test.pdf"
sPDFPath = "D:" & Application.PathSeparator

'Check if worksheet is empty and exit if so
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
  If .cStart("/NoProcessingAtStartup") = False Then
    MsgBox "Can't initialize PDFCreator.", vbCritical + _
      vbOKOnly, "PrtPDFCreator"
    Exit Sub
  End If
  .cOption("UseAutosave") = 1
  .cOption("UseAutosaveDirectory") = 1
  .cOption("AutosaveDirectory") = sPDFPath
  .cOption("AutosaveFilename") = sPDFName
  .cOption("AutosaveFormat") = 0 ' 0 = PDF
  .cClearCache
End With

'Print the document to PDF
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
  DoEvents
Loop
pdfjob.cPrinterStop = False

'Wait until the file shows up before closing PDF Creator
Do
  DoEvents
Loop Until Dir(sPDFPath & sPDFName) = sPDFName

pdfjob.cClose

Call sendMail(ActiveSheet.Range("Mail").Text, "Dein Betreff", "Deine Nachricht", sPDFPath & sPDFName)

Set pdfjob = Nothing
End Sub

Sub sendMail(ByVal MailAdress As String, ByVal Subject As String, ByVal Message As String, Optional Attach As String = "")
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
  .To = MailAdress
  .Subject = Subject
  .Body = Message
  If Len(Attach) Then .Attachments.Add (Attach)
  .send 'or .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Gruß Sepp


Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sabrina
Geschrieben am: 29.11.2015 17:19:44
Hallo Sepp,
es kommt eine Fehlermeldung 429 (Objekterstellung durch ActiveX-Komponente nicht möglich)
mit dem Verweis auf diese Zeile


Private WithEvents pdfjob As clsPDFCreator

LG
Sabbel

Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sabrina
Geschrieben am: 29.11.2015 17:22:12
Sorry .. auf diese Zeile

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
Ich habe dann gesucht und gefunden dass man die Zeile Private "WithEvents pdfjob As clsPDFCreator" einfügen soll .. aber es ändert sich nichts
LG
Sabbel

Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sepp
Geschrieben am: 29.11.2015 17:41:01
Hallo Sabrina,
dann so.

Sub PdfWithPDFCreatorZwei()
Dim objPDFCreator As Object, objPrint As Object
Dim strActPrinter As String

On Error GoTo Errorhandler

strActPrinter = Application.ActivePrinter

Application.ActivePrinter = "PDFCreator"

Set objPDFCreator = CreateObject("PDFCreatorBeta.JobQueue")

objPDFCreator.Initialize

ActiveSheet.PrintOut

objPDFCreator.WaitForJob (10)

Set objPrint = objPDFCreator.NextJob

With objPrint
  .SetProfileByGuid ("DefaultGuid")
  .SetProfileSetting "EmailClient.Enabled", "true"
  .SetProfileSetting "EmailClient.Subject", "Betreff"
  .SetProfileSetting "EmailClient.Content", "Deine Nachricht"
  .SetProfileSetting "EmailClient.Recipients", ActiveSheet.Range("Mail").Text
  .ConvertTo ("E:\Test.pdf")
  
  If .IsFinished = True Then
    objPDFCreator.ReleaseCom
  End If
End With


Errorhandler:
Application.ActivePrinter = strActPrinter
objPDFCreator.ReleaseCom
Set objPDFCreator = Nothing
Set objPrint = Nothing
End Sub


Gruß Sepp


Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sabrina
Geschrieben am: 29.11.2015 17:49:02
Hallo Sepp,
jetzt kommt bei "objPDFCreator.ReleaseCom" die Fehlermeldung
Laufzeitfehler 91
Objektvariable oder Whith_Blockvariable nicht festgelegt,
Gruß
Sabbel

Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sepp
Geschrieben am: 29.11.2015 17:51:28
Hallo Sabrina,
nach "Errorhandler:" ? Dann lösch die Zeile mit "objPDFCreator.ReleaseCom"

Gruß Sepp


Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sabrina
Geschrieben am: 29.11.2015 18:22:25
Ich bekomme es nicht hin :(
Die Methode springt bei Application.ActivePrinter = "PDFCreator" immer auf den Errorhandler:
Wenn ich das deaktiviere kommt Laufzeitfehler 1004 (Die Mehtode 'ActivePrinter' für das Objekt '_Aplication" ist fehlgeschlagen
:'(
Gruß Sabbel

Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sepp
Geschrieben am: 29.11.2015 18:27:15
Hallo Sabrina,
dann heißt dein PDF-Drucker anders.

Sub ap()
Debug.Print Application.ActivePrinter
End Sub

Stell mal den PDF-Creator als Drucker ein und führe den Code aus, im Direktfenster steht dann der Name, den musst du dann im Code statt "PDFCreator" einfügen.
Gruß Sepp


Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sabrina
Geschrieben am: 29.11.2015 19:15:10
Hej Sepp ... super.
Es funktioniert ... Danke ... du bist der Beste!
Ich habe nur noch eine Bitte.
Es gibt die Zelle "Mail", die Zelle "Telefon" und die Zelle "Mobil"
Leider kann es sein dass die E-Mail Adresse auch in einer der beiden anderen Zellen steht.
Ist es möglich abzufragen ob in einer Zelle eine E-Mail Adresse steht. Und diese zu nehmen.
Und wenn keine in den drei Zellen steht ein Fenster aufgehen zu lassen in dem man die Adresse eingeben kann?
LG
Sabbel

Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sepp
Geschrieben am: 29.11.2015 19:26:45
Hallo Sabrina,
es wird nur geprüft, ob es sich um eine gültige Mailadresse handelt, nicht ob diese auch existiert!
Druckernamen anpassen nicht vergessen!

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Sub PdfWithPDFCreatorZwei()
Dim objPDFCreator As Object, objPrint As Object
Dim strActPrinter As String, strRec As String

On Error GoTo Errorhandler

strRec = ActiveSheet.Range("Mail").Text

If Not IsValidMailAddress(strRec) Then strRec = ActiveSheet.Range("Telefon").Text

If Not IsValidMailAddress(strRec) Then strRec = ActiveSheet.Range("Mobil").Text

If Not IsValidMailAddress(strRec) Then
  strRec = InputBox("Bitte Empfängeradresse angeben:", "Mail")
  If strRec = "" Then Exit Sub
End If

strActPrinter = Application.ActivePrinter

Application.ActivePrinter = "PDFCreator"

Set objPDFCreator = CreateObject("PDFCreatorBeta.JobQueue")

objPDFCreator.Initialize

ActiveSheet.PrintOut

objPDFCreator.WaitForJob (10)

Set objPrint = objPDFCreator.NextJob

With objPrint
  .SetProfileByGuid ("DefaultGuid")
  .SetProfileSetting "EmailClient.Enabled", "true"
  .SetProfileSetting "EmailClient.Subject", "Betreff"
  .SetProfileSetting "EmailClient.Content", "Deine Nachricht"
  .SetProfileSetting "EmailClient.Recipients", strRec
  .ConvertTo ("E:\Test.pdf")
  
  If .IsFinished = True Then
    objPDFCreator.ReleaseCom
  End If
End With


Errorhandler:
Application.ActivePrinter = strActPrinter
Set objPDFCreator = Nothing
Set objPrint = Nothing
End Sub

Private Function IsValidMailAddress(ByVal strAddress As String) As Boolean
Dim oRegExp As Object
Set oRegExp = CreateObject("vbscript.regexp")

With oRegExp
  .Pattern = "[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|" & _
    "}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:" & _
    "[a-z0-9-]*[a-z0-9])?"
  
  .IgnoreCase = True
  
  IsValidMailAddress = .test(strAddress)
End With

Set oRegExp = Nothing

End Function

Gruß Sepp


Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: mumpel
Geschrieben am: 29.11.2015 20:08:25
Die Email-Prüffunktion gefällt mir. Werde ich in Zukunft nutzen wenn nichts dagegen spricht (mit Autorenhinweis natürlich).

Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sepp
Geschrieben am: 29.11.2015 20:14:03
Hallo mumpel,
gerne, aber den Pattern hab ich auch "geklaut", weiß aber nicht mehr von wo :-))

Gruß Sepp


Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sabrina
Geschrieben am: 29.11.2015 20:44:43
Vielen Dank .. wunderbar ^^
Aber eins habe ich ja immer noch :D
Die PDF wird in D:\test.php gespeichert.
Wollte das Flexibel gestalten und habe die Zeile in

.ConvertTo ("D:\PDF\" & Wert & ".pdf")
geändert
Wert habe ich am Anfang als String deklariert und mit
Wert = Range("F19")
festgelegt.
Aber das funktioniert nicht. Was mache ich Falsch?

Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: mumpel
Geschrieben am: 29.11.2015 21:04:36
Wert = Range("F19").Value

Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sabrina
Geschrieben am: 30.11.2015 17:58:44
Hallo Sepp, hallo Leute.
Ich habe noch immer ein Problem mit dem Skript.
Wenn ich die Zeile

Application.ActivePrinter = "PDFCreator"

drinnen habe dann springt das Programm an der Stelle immer auf "Errorhandler:"
Wenn ich die Zeile auskommentiere wird immer auf den zur Zeit Aktiven Drucker gedruckt.
Und der Drucker heisst so wie er angegeben ist :(
Wo liegt mein Fehler
LG
Sabbel
Userbild

Bild

Betrifft: AW: Blatt als PDF speichern und mailen
von: Sepp
Geschrieben am: 30.11.2015 18:11:51
Hallo Sabrina,
dann schreib doch mal.

Application.ActivePrinter = "PDFCreator auf Ne02:"
Gruß Sepp


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Blatt als PDF speichern und mailen"