Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Excel 2010 Makro Probleme mit komp. Excel 2013, Qualität von PDF und Dateinamen

Frage Microsoft Microsoft Office

Mitglied: Aeschli

Aeschli (Level 1) - Jetzt verbinden

23.10.2014, aktualisiert 28.10.2014, 1328 Aufrufe, 17 Kommentare

Hallo Leute...

Brauch dringende eure Unterstützung.
Bin seit kurzem Makro-Anwender und hab mir seit dem alles aus dem Internet heraus gesucht was ich benötige. Bin au ziemlich weit gekommen, nun aber bin ich mit meinen Stichwortsuche am Ende. Folgend mal mein aktueller Code:
01.
Public Sub TabelleAlsPdf() 
02.
 
03.
Dim olApp      As Object 
04.
Dim AWS        As String 
05.
Dim olOldBody  As String 
06.
Dim strAddress As String 
07.
Dim i          As Integer 
08.
 
09.
' Rem Pfad für PDF festlegen 
10.
AWS = "H:\XXX\YYY\AB " & Range("M25") & " " & Range("E14") & ".pdf" 
11.
 
12.
' Bestimmen der E-Mailadresse 
13.
strAddress = Range("O19") 
14.
 
15.
' Rem Tabelle2 als PDF speichern 
16.
If Dir(AWS) = "" Then 
17.
ThisWorkbook.Sheets("AB TL").ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, Quality:=xlQualityStandard, _ 
18.
                                                    IncludeDocProperties:=False, IgnorePrintAreas:=False, _ 
19.
                                                    OpenAfterPublish:=False 
20.
Else 
21.
   MsgBox "Der verwendete Dateiname ist bereits vorhanden." 
22.
   Exit Sub 
23.
End If 
24.
 
25.
Rem Email erstellen 
26.
Set olApp = CreateObject("Outlook.Application") 
27.
    With olApp.CreateItem(0) 
28.
        Set .SendUsingAccount = .Session.Accounts.Item("info@moebelagentur.ch") ' Sendekonto vorwählen (für jede Emailadresse eine _ 
29.
                                                                        eigene Datendatei erforderlich). _ 
30.
                                                                        "Kontoname" = Name des Kontos (in Anführungszeichen) _ 
31.
                                                                        wie er in Outlook angezeigt wird. 
32.
              .GetInspector.Display 
33.
              olOldBody = .htmlBody 
34.
              .To = strAddress 
35.
              .Subject = "Auftragsbestätigung " & Range("M25") & " - " & Range("J28")  ' Betreff 
36.
              .htmlBody = "<span style=""font-size:11pt; font-family:'calibri'"">" & _ 
37.
                          "Sehr geehrte Damen und Herren<br><br>" & _ 
38.
                          "Herzlichen Dank für Ihre Bestellung.<br>" & _ 
39.
                          "Im Anhang finden Sie die entsprechende Auftragsbestätigung.<br><br>" & _ 
40.
                          "Wir bitten Sie die Auftragsbestätigung zu kontrollieren. Ohne Gegenbericht innert 5 Tagen gilt der Auftrag als genehmigt." & olOldBody ' Body. "<br>" = Zeilenumbruchanweisung 
41.
              .Attachments.Add AWS 'Datei anhängen 
42.
      
43.
    End With 
44.
 
45.
End Sub
Folgende Schwierigkeit gilt es noch zu beheben, bevor ich diesen Einsetzen kann:

1. Der Code ist in dieser Form nicht mit Excel 2013 kompatibel. "Laufzeitfehler" oder "Fehler 400" werden angezeigt. Was muss ich ändern damit dieser auch auf dem neuen Office läuft? (Auf Excel 2010 läuft alles geschmeidig)
Der Computer mit dem Excel 2013 ist zurzeit nicht verfügbar, daher kann ich nichts testen. Aber könnte es helfen wenn ich die Excel Datei mit dem Makro mit 2013 öffne, einmal abspeichere, alles schliessen und wieder öffne?

2. Die Erstellung der PDF's läuft absolut problemlos und das Dokument wird auch richtig im Outlook angefügt. Nur ist das Problem, dass das PDF-Dokument extrem hässlich aussieht von der Qualität. Kennt jemand eine Variante/Möglichkeit wie ich ein schöneres PDF erstellen kann?
Eine Variante die ich noch erforschen konnte, ist der Weg über den PDFCreator. Hatte aber bis anhin kein Erfolg bei der Integration eines Codes der den PDFCreator ansteuert.

3. Beim speichern des PDF's wird gleichzeitig geprüft ob der Dateiname schon vorhanden ist. Gibt es eine möglichkeit, dass der Dateiname automatisch um einen bestimmten Text (z.B. Version 2) erweitert wird, falls es diese Datei schon gibt?
Dazu gibt es (soweit ich weiss) die DIR() funktion. Hab aber nicht geschnallt wo dieser hin muss!

Habt Ihr ideen?
Freue mich auf eure Antworten

Gruss
GmbH
Mitglied: Eintagsfliege
23.10.2014 um 13:12 Uhr
Hallo Aeschli!

Zum Laufzeitfehler kann ich leider nix sagen, da ich kein Outlook nutze?

Den Pdf-Creater kannst Du in etwa so verwenden:
01.
ThisWorkbook.Sheets("AB TL").PrintOut , , 1, , "PDFCreater"
Grüße Dieter
Bitte warten ..
Mitglied: colinardo
23.10.2014, aktualisiert um 14:01 Uhr
Hi,
also so läuft das auch testweise auf einem Outlook 2013 mit deiner gewünschten Erweiterung (Anhängen einer Nummer falls eine Datei schon existiert.)
01.
Public Sub TabelleAlsPdf() 
02.
	Dim olApp      	As Object 
03.
	Dim fso  	As Object 
04.
	Dim AWS        	As String 
05.
	Dim olOldBody  	As String 
06.
	Dim strAddress 	As String 
07.
	Dim i          	As Integer 
08.
        Dim cnt         As integer 
09.
	 
10.
        'Filesystem-Object erzeugen 
11.
	Set fso = CreateObject("Scripting.FileSystemObject")   
12.
	 
13.
	' Rem Pfad für PDF festlegen 
14.
	AWS = "H:\XXX\YYY\AB " & Range("M25") & " " & Range("E14") & ".pdf" 
15.
	 
16.
	'Falls Datei schon existiert, hänge Nummer an 
17.
	cnt = 1 
18.
	While fso.FileExists(AWS) 
19.
		AWS = fso.GetParentFolderName(AWS) & "\" & fso.GetBaseName(AWS) & "(" & cnt & ")." & fso.GetExtensionName(AWS) 
20.
		cnt = cnt + 1 
21.
	Wend 
22.
	 
23.
	' Bestimmen der E-Mailadresse 
24.
	strAddress = Range("O19").Value 
25.
	 
26.
	' Rem Tabelle2 als PDF speichern 
27.
	ThisWorkbook.Sheets("AB TL").ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False 
28.
 
29.
'Email erstellen 
30.
	Set olApp = CreateObject("Outlook.Application") 
31.
	With olApp.CreateItem(0) 
32.
        Set .SendUsingAccount = .Session.Accounts.Item("info@moebelagentur.ch") ' Sendekonto vorwählen 
33.
		olOldBody = .htmlBody 
34.
		.To = strAddress 
35.
		.Subject = "Auftragsbestätigung " & Range("M25") & " - " & Range("J28")  ' Betreff 
36.
		.htmlBody = "<span style=""font-size:11pt; font-family:'calibri'"">" & _ 
37.
		          "Sehr geehrte Damen und Herren<br><br>" & _ 
38.
		          "Herzlichen Dank für Ihre Bestellung.<br>" & _ 
39.
		          "Im Anhang finden Sie die entsprechende Auftragsbestätigung.<br><br>" & _ 
40.
		          "Wir bitten Sie die Auftragsbestätigung zu kontrollieren. Ohne Gegenbericht innert 5 Tagen gilt der Auftrag als genehmigt." & olOldBody ' Body. "<br>" = Zeilenumbruchanweisung 
41.
		.Attachments.Add AWS 'Datei anhängen 
42.
		.Display 
43.
    End With 
44.
    Set olApp = Nothing 
45.
    Set fso = Nothing 
46.
End Sub
Zum alternativen PDF-Export siehe den Kommentar von Dieter.

Grüße Uwe
Bitte warten ..
Mitglied: Aeschli
24.10.2014 um 10:34 Uhr
Hallo Dieter, Hallo Uwe

Danke für eure Antworten.
Bin meinem Ziel ein Stück näher. Ich habe dank Dieters Hinweis einen Code gefunden mit dem ich den PDFCreator komplett steuern kann und er mir das gewünschte Ergebnis ausspuckt. Nun aber funktioniert der Part von Uwe leider nicht mehr. Ich versuchte diesen zu integrieren aber der will nicht so recht.
Bei Zeile 47 und 48 ersetzt er die Datei einfach durch die neue. Kennt Ihr den richtigen Befehl der anstelle von "Kill" kommt? Oder eine andere möglichkeit den Dateiname zu erweitern falls dieser schon existiert?

Hier mal mein aktueller Code (Quelle des Codes: http://www.excelguru.ca/content.php?161-Printing-Worksheets-To-A-PDF-Fi ...):
01.
Public Sub TabelleAlsPdf() 
02.
 
03.
Dim olApp      As Object 
04.
Dim fso        As Object 
05.
Dim s(1)       As String 
06.
Dim olOldBody  As String 
07.
Dim strAddress As String 
08.
Dim i          As Integer 
09.
Dim sPDFName   As String 
10.
Dim sPDFPath   As String 
11.
Dim bRestart   As Boolean 
12.
Dim pdfjob     As PDFCreator.clsPDFCreator 
13.
 
14.
    'Filesystem-Object erzeugen 
15.
    Set fso = CreateObject("Scripting.FileSystemObject") 
16.
 
17.
    ' Bestimmen der E-Mailadresse 
18.
    strAddress = Range("O19") 
19.
 
20.
    '/// Change the output file name here! /// 
21.
    sPDFName = "AB " & Range("M25") & " " & Range("E14") & ".pdf" 
22.
    sPDFPath = "H:\XXX\YYY\" 
23.
 
24.
    'Check if PDFCreator is already running and attempt to kill the process if so 
25.
    Do 
26.
        bRestart = False 
27.
        Set pdfjob = New PDFCreator.clsPDFCreator 
28.
        If pdfjob.cStart("/NoProcessingAtStartup") = False Then 
29.
            'PDF Creator is already running.  Kill the existing process 
30.
            Shell "taskkill /f /im PDFCreator.exe", vbHide 
31.
            DoEvents 
32.
            Set pdfjob = Nothing 
33.
            bRestart = True 
34.
        End If 
35.
    Loop Until bRestart = False 
36.
 
37.
    'Assign settings for PDF job 
38.
    With pdfjob 
39.
        .cOption("UseAutosave") = 1 
40.
        .cOption("UseAutosaveDirectory") = 1 
41.
        .cOption("AutosaveDirectory") = sPDFPath 
42.
        .cOption("AutosaveFilename") = sPDFName 
43.
        .cOption("AutosaveFormat") = 0    ' 0 = PDF 
44.
        .cClearCache 
45.
    End With 
46.
 
47.
    'Delete the PDF if it already exists 
48.
    If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName) 
49.
     
50.
    'Print the document to PDF 
51.
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator" 
52.
 
53.
    'Wait until the print job has entered the print queue 
54.
    Do Until pdfjob.cCountOfPrintjobs = 1 
55.
        DoEvents 
56.
    Loop 
57.
    pdfjob.cPrinterStop = False 
58.
 
59.
    'Wait until the file shows up before closing PDF Creator 
60.
    Do 
61.
        DoEvents 
62.
    Loop Until Dir(sPDFPath & sPDFName) = sPDFName 
63.
 
64.
Cleanup: 
65.
    'Release objects and terminate PDFCreator 
66.
    Set pdfjob = Nothing 
67.
    Shell "taskkill /f /im PDFCreator.exe", vbHide 
68.
    On Error GoTo 0 
69.
    Application.ScreenUpdating = True 
70.
 
71.
Rem Email erstellen 
72.
Set olApp = CreateObject("Outlook.Application") 
73.
    With olApp.CreateItem(0) 
74.
        Set .SendUsingAccount = .Session.Accounts.Item("XXX@XXX.ch") ' Sendekonto vorwählen (für jede Emailadresse eine _ 
75.
                                                                        eigene Datendatei erforderlich). _ 
76.
                                                                        "Kontoname" = Name des Kontos (in Anführungszeichen) _ 
77.
                                                                        wie er in Outlook angezeigt wird. 
78.
              .GetInspector.Display 
79.
              olOldBody = .htmlBody 
80.
              .To = strAddress 
81.
              .Subject = "Auftragsbestätigung " & Range("M25") & " - " & Range("J28")  ' Betreff 
82.
              .htmlBody = "<span style=""font-size:11pt; font-family:'calibri'"">" & _ 
83.
                          "Sehr geehrte Damen und Herren<br><br>" & _ 
84.
                          "Herzlichen Dank für Ihre Bestellung.<br>" & _ 
85.
                          "Im Anhang finden Sie die entsprechende Auftragsbestätigung.<br><br>" & _ 
86.
                          "Wir bitten Sie die Auftragsbestätigung zu kontrollieren. Ohne Gegenbericht innert 5 Tagen gilt der Auftrag als genehmigt." & olOldBody ' Body. "<br>" = Zeilenumbruchanweisung 
87.
              .Attachments.Add (sPDFPath & sPDFName) 'Datei anhängen 
88.
              .Display 
89.
    End With 
90.
    Set olApp = Nothing 
91.
    Set fso = Nothing 
92.
End Sub 
93.
 
Gruss Aeschli
Bitte warten ..
Mitglied: Eintagsfliege
24.10.2014, aktualisiert um 16:56 Uhr
Hallo Aeschli!

So sollte es funktionieren:
01.
Public Sub PrintToPdfCreater() 
02.
    Dim oPdf_Creater As Object, sPdf_Path As String, sPdf_Name As String 
03.
 
04.
    sPdf_Path = "H:\XXX\YYY\" 
05.
    sPdf_Name = "AB " & Range("M25") & " " & Range("E14")  'ohne ".pdf" 
06.
 
07.
    Set oPdf_Creater = CreateObject("PDFCreator.clsPDFCreator") 
08.
 
09.
    If oPdf_Creater.cStart("/NoProcessingAtStartup") = False Then 
10.
        MsgBox "Initialisierung von PDFCreator fehlgeschlagen!", vbExclamation, "Fehler" 
11.
        Exit Sub 
12.
    End If 
13.
 
14.
    With oPdf_Creater 
15.
        .cOption("UseAutosave") = 1 
16.
        .cOption("UseAutosaveDirectory") = 1 
17.
        .cOption("AutosaveDirectory") = sPdf_Path 
18.
        .cOption("AutosaveFilename") = sPdf_Name 
19.
        .cOption("AutosaveFormat") = 0 
20.
        .cClearCache 
21.
    End With 
22.
 
23.
    ThisWorkbook.Sheets("AB TL").PrintOut Copies:=1, "PDFCreator auf Ne04:"   'Genaue Bezeichnung ermitteln 
24.
  
25.
    With oPdf_Creater 
26.
        Do Until .cCountOfPrintjobs = 1:  Loop 
27.
       .cCombineAll 
28.
       .cPrinterStop = False 
29.
        Do Until .cCountOfPrintjobs = 0:  Loop 
30.
       .cClose 
31.
    End With 
32.
 
33.
    Set oPdf_Creater = Nothing 
34.
 
35.
    sPdf_Path = sPdf_Path & sPdf_Name & ".pdf" 
36.
     
37.
    'Ab hier Uwe's Outlook-Code 
38.
 
39.
End Sub
Grüße Dieter
Bitte warten ..
Mitglied: Aeschli
24.10.2014 um 12:41 Uhr
Hi Dieter

Danke für den Code. Leider hängt er in einem Loop fest, welcher verursacht das der PDFCreator immer wieder gestartet wird, nachdem ich ihn manuell geschlossen habe. Dazu kommt das der Papier drucker sich auch noch meldet und das Worksheet ausdruckt - Sorry, leider tut es nicht das was es soll!
Was ich aber in deinem Code nicht sehe, wo genau prüft er den Dateiname und hängt dann nach bedarf automatisch ein Zahl oder ähnliches an?

Gruss Aeschli
Bitte warten ..
Mitglied: Eintagsfliege
24.10.2014, aktualisiert um 13:09 Uhr
Hallo Aeschli!

Ich vermute mal, dass der Druckauftrag nicht an den Pdf-Creater gesendet wird. Sie mal unter <Geräte und Drucker>, ob der Pdf-Creater dort auch als "PdfCreater" drinnen steht?

Grüße Dieter

PS.
Was ich aber in deinem Code nicht sehe, wo genau prüft er den Dateiname und hängt dann nach bedarf automatisch ein Zahl oder ähnliches an?
Wenn vorhanden, dann wird die Datei einfach überschrieben...
Bitte warten ..
Mitglied: Aeschli
24.10.2014, aktualisiert um 13:17 Uhr
"PDFCreator" steht bei mir und <Geräte und Drucker>! Das sollte also stimmen...
Bei meinem Kommentar von Heute 10.24 Uhr, steht der Code bei dem alles einwandfrei funktioniert, bis auf die Dateinamens änderung. Ich hab einfach noch keinen Code gefunden der das Problem löst -.-'

PS.
>>Was ich aber in deinem Code nicht sehe, wo genau prüft er den Dateiname und hängt dann nach bedarf automatisch ein Zahl oder ähnliches an?
>Wenn vorhanden, dann wird die Datei einfach überschrieben...face-wink
Es geht mir ja genau darum, dass wenn die Datei schon vorhanden ist, der Name am schluss mit einem "Version 2" versehen wird. Damit die alte Datei nicht überschrieben wird!
Bitte warten ..
Mitglied: colinardo
24.10.2014, aktualisiert um 13:42 Uhr
Zitat von Aeschli:
Es geht mir ja genau darum, dass wenn die Datei schon vorhanden ist, der Name am schluss mit einem "Version 2" versehen
wird. Damit die alte Datei nicht überschrieben wird!
das macht mein Code aber bereits zuverlässig mit den folgenden Zeilen aus meinem obigen Code!!
01.
      'Filesystem-Object erzeugen 
02.
	Set fso = CreateObject("Scripting.FileSystemObject")   
03.
	 
04.
	' Rem Pfad für PDF festlegen 
05.
	AWS = "H:\XXX\YYY\AB " & Range("M25") & " " & Range("E14") & ".pdf" 
06.
	 
07.
	'Falls Datei schon existiert, hänge Nummer an 
08.
	cnt = 1 
09.
	While fso.FileExists(AWS) 
10.
		AWS = fso.GetParentFolderName(AWS) & "\" & fso.GetBaseName(AWS) & "(" & cnt & ")." & fso.GetExtensionName(AWS) 
11.
		cnt = cnt + 1 
12.
	Wend
sollte der Pfad schon existieren ändert es die Zahl hinten dran solange bis der Dateipfad nicht existiert und somit frei ist ... geht einwandfrei, ich poste hier ja keine Sachen die in nicht getestet hätte !
Bitte warten ..
Mitglied: Eintagsfliege
24.10.2014, aktualisiert um 13:42 Uhr
Hallo zusammen!

OK, dass hab ich dann komplett übersehen und nur den Druckvorgang berücksichtigt, der bei mir auch einwandfrei funktioniert...

Grüße Dieter
Bitte warten ..
Mitglied: Aeschli
24.10.2014 um 13:55 Uhr
Zitat von colinardo:

> Zitat von Aeschli:
> Es geht mir ja genau darum, dass wenn die Datei schon vorhanden ist, der Name am schluss mit einem "Version 2"
versehen
> wird. Damit die alte Datei nicht überschrieben wird!
das macht mein Code aber bereits zuverlässig mit den folgenden Zeilen aus meinem obigen Code!!
01.
>       'Filesystem-Object erzeugen 
02.
> 	Set fso = CreateObject("Scripting.FileSystemObject")   
03.
> 	 
04.
> 	' Rem Pfad für PDF festlegen 
05.
> 	AWS = "H:\XXX\YYY\AB " & Range("M25") & " " & Range("E14") & 
06.
> ".pdf" 
07.
> 	 
08.
> 	'Falls Datei schon existiert, hänge Nummer an 
09.
> 	cnt = 1 
10.
> 	While fso.FileExists(AWS) 
11.
> 		AWS = fso.GetParentFolderName(AWS) & "\" & fso.GetBaseName(AWS) & "(" & cnt & 
12.
> ")." & fso.GetExtensionName(AWS) 
13.
> 		cnt = cnt + 1 
14.
> 	Wend 
15.
> 
sollte der Pfad schon existieren ändert es die Zahl hinten dran solange bis der Dateipfad nicht existiert und somit frei ist
... geht einwandfrei, ich poste hier ja keine Sachen die in nicht getestet hätte !

Geb ich dir recht... Passt alles wunderbar. Aber leider nur mit dem alten Code! Da ich gestern den Code geändert habe um den PDFCreator anzusteuer und zu managen, will deine Variante nicht mehr so richtig. Mein aktueller Code findest du in meinem Kommentar von heute morgen 10.34 Uhr.
Hast du eine Idee wie ich diesen integrieren kann?
Bitte warten ..
Mitglied: colinardo
24.10.2014, aktualisiert um 14:11 Uhr
Hast du eine Idee wie ich diesen integrieren kann?
bin noch unterwegs, schaue da heut Abend mal drauf... oder der Dieter vertritt mich
Bitte warten ..
Mitglied: Aeschli
24.10.2014 um 15:54 Uhr
Zitat von colinardo:

> Hast du eine Idee wie ich diesen integrieren kann?
bin noch unterwegs, schaue da heut Abend mal drauf... oder der Dieter vertritt mich

Super! Vielen dank... Hab leider nacher weiteren Google-Aktivitäten immer noch nicht die passende Lösung!
Bitte warten ..
Mitglied: Eintagsfliege
24.10.2014, aktualisiert um 16:43 Uhr
Hallo Aeschli!

So, habe jetzt mal mit Win7 und Excel 2013 getestet und festgestellt, dass 'ActivePrinter' in PrintOut etwas anders funktioniert. Hier muss die vollständige Bezeichnung angegeben werden z.B. "PDFCreator auf Ne04:" (Code oben entsprechend geändert):
01.
 ThisWorkbook.Sheets("AB TL").PrintOut Copies:=1, ActivePrinter = "PDFCreator auf Ne04:"
Wobei Du aber die genaue Printerbezeichnung vom PdfCreater ermitteln musst, indem Du erstmal den PdfCreater als Excel-Default auswählst und dann mit 'Printer = Application.ActivePrinter' die vollständige Bezeichnung ausliest.

Schreibe eine kleine Test-Sub zum Auslesen der Printerbezeichnung.

Wenn die Printerbezeichnung stimmt, dann erübrigen sich die Taskkills vom Pdf-Creater, weil er dann ordnungsgemäß geöffnet und geschlossen wird...

Uwe's Outlook-Funktion sollte dann auch gehen?

Grüße Dieter
Bitte warten ..
Mitglied: Aeschli
24.10.2014 um 16:48 Uhr
Alles was Excel/Outlook 2013 betriff erst nächste Woche testen, da ich die betreffende Maschine nicht habe zurzeit. Werde dann aber gern deinem Rat folgen.

Möchte aber bei Möglichkeit das Problem mit dem Dateiname bis dahin hingekriegt haben. Ich möchte dann 2013 testen, wenn der Code auf 2010 fertig ist. Sonst hab ich 2 Baustellen....
Bitte warten ..
Mitglied: Eintagsfliege
LÖSUNG 24.10.2014, aktualisiert 28.10.2014
Hallo zusammen!

bin noch unterwegs, schaue da heut Abend mal drauf... oder der Dieter vertritt mich
OK, ich versuchs mal


Mit Dateiüberprüfung und gegebenenfalls eine fortlaufende Zahl anhängen:
01.
Option Explicit 
02.
 
03.
Public Sub SendPdfMail() 
04.
    Dim oFso As Object, oPdf_Creater As Object, olApp As Object 
05.
    Dim sPdf_Path As String, sPdf_Name As String, sFileName As String, olOldBody As String 
06.
    Dim sDefaultPrinter As String, iCount As Integer 
07.
     
08.
    Set oPdf_Creater = CreateObject("PDFCreator.clsPDFCreator") 
09.
     
10.
    If oPdf_Creater.cStart("/NoProcessingAtStartup") = False Then 
11.
        Set oPdf_Creater = Nothing 
12.
        MsgBox "Initialisierung von PDFCreator fehlgeschlagen!", vbExclamation, "Fehler" 
13.
        Exit Sub 
14.
    End If 
15.
 
16.
    sDefaultPrinter = Application.ActivePrinter 
17.
     
18.
    If SetPdfPrinter = False Then 
19.
        Set oPdf_Creater = Nothing 
20.
        MsgBox "PDFCreator nicht gefunden!", vbExclamation, "Fehler" 
21.
        Exit Sub 
22.
    End If 
23.
     
24.
    sPdf_Path = "H:\XXX\YYY\" 
25.
    sPdf_Name = "AB " & Range("M25").Value & " " & Range("E14").Value 
26.
     
27.
    With CreateObject("Scripting.FileSystemObject") 
28.
        sFileName = sPdf_Path & sPdf_Name & ".pdf" 
29.
         
30.
        While .FileExists(sFileName) 
31.
            iCount = iCount + 1 
32.
            sFileName = sPdf_Path & sPdf_Name & "_" & iCount & ".pdf" 
33.
        Wend 
34.
        sPdf_Name = .GetBaseName(sFileName) 
35.
    End With 
36.
     
37.
    With oPdf_Creater 
38.
        .cOption("UseAutosave") = 1 
39.
        .cOption("UseAutosaveDirectory") = 1 
40.
        .cOption("AutosaveDirectory") = sPdf_Path 
41.
        .cOption("AutosaveFilename") = sPdf_Name 
42.
        .cOption("AutosaveFormat") = 0 
43.
        .cClearCache 
44.
    End With 
45.
 
46.
    ActiveSheet.PrintOut Copies:=1 
47.
    Application.ActivePrinter = sDefaultPrinter 
48.
 
49.
    With oPdf_Creater 
50.
        Do Until .cCountOfPrintjobs = 1:  Loop 
51.
       .cCombineAll 
52.
       .cPrinterStop = False 
53.
        Do Until .cCountOfPrintjobs = 0:  Loop 
54.
       .cClose 
55.
    End With 
56.
 
57.
    Set oPdf_Creater = Nothing 
58.
    Set olApp = CreateObject("Outlook.Application") 
59.
 
60.
    With olApp.CreateItem(0) 
61.
        Set .SendUsingAccount = .Session.Accounts.Item("info@moebelagentur.ch") ' Sendekonto vorwählen 
62.
        olOldBody = .htmlBody 
63.
        .To = Range("O19").Value 
64.
        .Subject = "Auftragsbestätigung " & Range("M25") & " - " & Range("J28")  ' Betreff 
65.
        .htmlBody = "<span style=""font-size:11pt; font-family:'calibri'"">" & _ 
66.
                  "Sehr geehrte Damen und Herren<br><br>" & _ 
67.
                  "Herzlichen Dank für Ihre Bestellung.<br>" & _ 
68.
                  "Im Anhang finden Sie die entsprechende Auftragsbestätigung.<br><br>" & _ 
69.
                  "Wir bitten Sie die Auftragsbestätigung zu kontrollieren. Ohne Gegenbericht " & ´_ 
70.
                  "innerhalb von 5 Tagen gilt der Auftrag als genehmigt." & olOldBody 
71.
                  'Body. "<br>" = Zeilenumbruchanweisung 
72.
        .Attachments.Add sFileName 
73.
        .Display 
74.
    End With 
75.
    Set olApp = Nothing 
76.
End Sub 
77.
 
78.
Private Function SetPdfPrinter() As Boolean 
79.
    Dim sPrinter As String, i As Integer 
80.
     
81.
    On Error Resume Next 
82.
    With Application 
83.
        For i = 0 To 9 
84.
            sPrinter = "PDFCreator auf Ne0" & i & ":" 
85.
           .ActivePrinter = sPrinter 
86.
            If .ActivePrinter = sPrinter Then 
87.
                SetPdfPrinter = True:  Exit For 
88.
            End If 
89.
        Next 
90.
    End With 
91.
    On Error GoTo 0 
92.
End Function
Grüße Dieter

[edit] Code noch ein weing erweitert, sodass PdfCreater nun auch automatisch erkannt/gesetzt wird... [/edit]
Bitte warten ..
Mitglied: Aeschli
27.10.2014 um 09:46 Uhr
Hallo Leute

Vielen Dank für den Code Dieter!
Habe morgen wieder Zeit diesen zu testen. Melde mich dann wieder....

Guten Wochenstart wünsch ich euch!

Gruss Aeschli
Bitte warten ..
Mitglied: Aeschli
28.10.2014 um 17:42 Uhr
Zitat von Eintagsfliege:

Hallo zusammen!

> bin noch unterwegs, schaue da heut Abend mal drauf... oder der Dieter vertritt mich
OK, ich versuchs mal


Mit Dateiüberprüfung und gegebenenfalls eine fortlaufende Zahl anhängen:
01.
> Option Explicit 
02.
>  
03.
> Public Sub SendPdfMail() 
04.
>     Dim oFso As Object, oPdf_Creater As Object, olApp As Object 
05.
>     Dim sPdf_Path As String, sPdf_Name As String, sFileName As String, olOldBody As String 
06.
>     Dim sDefaultPrinter As String, iCount As Integer 
07.
>      
08.
>     Set oPdf_Creater = CreateObject("PDFCreator.clsPDFCreator") 
09.
>      
10.
>     If oPdf_Creater.cStart("/NoProcessingAtStartup") = False Then 
11.
>         Set oPdf_Creater = Nothing 
12.
>         MsgBox "Initialisierung von PDFCreator fehlgeschlagen!", vbExclamation, "Fehler" 
13.
>         Exit Sub 
14.
>     End If 
15.
>  
16.
>     sDefaultPrinter = Application.ActivePrinter 
17.
>      
18.
>     If SetPdfPrinter = False Then 
19.
>         Set oPdf_Creater = Nothing 
20.
>         MsgBox "PDFCreator nicht gefunden!", vbExclamation, "Fehler" 
21.
>         Exit Sub 
22.
>     End If 
23.
>      
24.
>     sPdf_Path = "H:\XXX\YYY\" 
25.
>     sPdf_Name = "AB " & Range("M25").Value & " " & Range("E14").Value 
26.
>      
27.
>     With CreateObject("Scripting.FileSystemObject") 
28.
>         sFileName = sPdf_Path & sPdf_Name & ".pdf" 
29.
>          
30.
>         While .FileExists(sFileName) 
31.
>             iCount = iCount + 1 
32.
>             sFileName = sPdf_Path & sPdf_Name & "_" & iCount & ".pdf" 
33.
>         Wend 
34.
>         sPdf_Name = .GetBaseName(sFileName) 
35.
>     End With 
36.
>      
37.
>     With oPdf_Creater 
38.
>         .cOption("UseAutosave") = 1 
39.
>         .cOption("UseAutosaveDirectory") = 1 
40.
>         .cOption("AutosaveDirectory") = sPdf_Path 
41.
>         .cOption("AutosaveFilename") = sPdf_Name 
42.
>         .cOption("AutosaveFormat") = 0 
43.
>         .cClearCache 
44.
>     End With 
45.
>  
46.
>     ActiveSheet.PrintOut Copies:=1 
47.
>     Application.ActivePrinter = sDefaultPrinter 
48.
>  
49.
>     With oPdf_Creater 
50.
>         Do Until .cCountOfPrintjobs = 1:  Loop 
51.
>        .cCombineAll 
52.
>        .cPrinterStop = False 
53.
>         Do Until .cCountOfPrintjobs = 0:  Loop 
54.
>        .cClose 
55.
>     End With 
56.
>  
57.
>     Set oPdf_Creater = Nothing 
58.
>     Set olApp = CreateObject("Outlook.Application") 
59.
>  
60.
>     With olApp.CreateItem(0) 
61.
>         Set .SendUsingAccount = .Session.Accounts.Item("info@moebelagentur.ch") ' Sendekonto vorwählen 
62.
>         olOldBody = .htmlBody 
63.
>         .To = Range("O19").Value 
64.
>         .Subject = "Auftragsbestätigung " & Range("M25") & " - " & 
65.
> Range("J28")  ' Betreff 
66.
>         .htmlBody = "<span style=""font-size:11pt; font-family:'calibri'"">" & 
67.
> _ 
68.
>                   "Sehr geehrte Damen und Herren<br><br>" & _ 
69.
>                   "Herzlichen Dank für Ihre Bestellung.<br>" & _ 
70.
>                   "Im Anhang finden Sie die entsprechende Auftragsbestätigung.<br><br>" & _ 
71.
>                   "Wir bitten Sie die Auftragsbestätigung zu kontrollieren. Ohne Gegenbericht " & ´_ 
72.
>                   "innerhalb von 5 Tagen gilt der Auftrag als genehmigt." & olOldBody 
73.
>                   'Body. "<br>" = Zeilenumbruchanweisung 
74.
>         .Attachments.Add sFileName 
75.
>         .Display 
76.
>     End With 
77.
>     Set olApp = Nothing 
78.
> End Sub 
79.
>  
80.
> Private Function SetPdfPrinter() As Boolean 
81.
>     Dim sPrinter As String, i As Integer 
82.
>      
83.
>     On Error Resume Next 
84.
>     With Application 
85.
>         For i = 0 To 9 
86.
>             sPrinter = "PDFCreator auf Ne0" & i & ":" 
87.
>            .ActivePrinter = sPrinter 
88.
>             If .ActivePrinter = sPrinter Then 
89.
>                 SetPdfPrinter = True:  Exit For 
90.
>             End If 
91.
>         Next 
92.
>     End With 
93.
>     On Error GoTo 0 
94.
> End Function 
95.
> 
Grüße Dieter

[edit] Code noch ein weing erweitert, sodass PdfCreater nun auch automatisch erkannt/gesetzt wird... [/edit]

Geiler Scheiss! Funktioniert tadellos *Freu* Danke euch viel mals.

Läuft also mit dem Code von Dieter (Alias: Eintagsfliege) nun auf 2010 sowie auf 2013!
Eine kleine Änderung auf Zeile 62. habe ich noch gemacht:
.GetInspector.Display 'Damit wird die standartisierte Signatur automatisch eingefügt

Nochmals vielen Dank!
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Microsoft Office
gelöst Excel 2010 Zellen mit bestimmten Inhalt mit Makro formartierten (5)

Frage von packmann2016 zum Thema Microsoft Office ...

Microsoft Office
Excel 2010 - Microsoft Excel kann die Daten nicht kopieren (4)

Frage von EDV-Oellerking zum Thema Microsoft Office ...

Microsoft Office
gelöst Verschieben von Zellinformation in andere Spalte (per VBA) excel 2010 (5)

Frage von thomas1972 zum Thema Microsoft Office ...

Windows 10
Excel 2010 unter Windows 10

Frage von MiSt zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (25)

Frage von M.Marz zum Thema Windows Server ...

SAN, NAS, DAS
gelöst HP-Proliant Microserver Betriebssystem (14)

Frage von Yannosch zum Thema SAN, NAS, DAS ...

Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

Windows 7
Verteillösung für IT-Raum benötigt (12)

Frage von TheM-Man zum Thema Windows 7 ...