Excel 2010 Makro Probleme mit komp. Excel 2013, Qualität von PDF und Dateinamen
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:
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
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:
Public Sub TabelleAlsPdf()
Dim olApp As Object
Dim AWS As String
Dim olOldBody As String
Dim strAddress As String
Dim i As Integer
' Rem Pfad für PDF festlegen
AWS = "H:\XXX\YYY\AB " & Range("M25") & " " & Range("E14") & ".pdf"
' Bestimmen der E-Mailadresse
strAddress = Range("O19")
' Rem Tabelle2 als PDF speichern
If Dir(AWS) = "" Then
ThisWorkbook.Sheets("AB TL").ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Else
MsgBox "Der verwendete Dateiname ist bereits vorhanden."
Exit Sub
End If
Rem Email erstellen
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
Set .SendUsingAccount = .Session.Accounts.Item("info@moebelagentur.ch") ' Sendekonto vorwählen (für jede Emailadresse eine _
eigene Datendatei erforderlich). _
"Kontoname" = Name des Kontos (in Anführungszeichen) _
wie er in Outlook angezeigt wird.
.GetInspector.Display
olOldBody = .htmlBody
.To = strAddress
.Subject = "Auftragsbestätigung " & Range("M25") & " - " & Range("J28") ' Betreff
.htmlBody = "<span style=""font-size:11pt; font-family:'calibri'"">" & _
"Sehr geehrte Damen und Herren<br><br>" & _
"Herzlichen Dank für Ihre Bestellung.<br>" & _
"Im Anhang finden Sie die entsprechende Auftragsbestätigung.<br><br>" & _
"Wir bitten Sie die Auftragsbestätigung zu kontrollieren. Ohne Gegenbericht innert 5 Tagen gilt der Auftrag als genehmigt." & olOldBody ' Body. "<br>" = Zeilenumbruchanweisung
.Attachments.Add AWS 'Datei anhängen
End With
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
Please also mark the comments that contributed to the solution of the article
Content-Key: 252836
Url: https://administrator.de/contentid/252836
Printed on: April 18, 2024 at 01:04 o'clock
17 Comments
Latest comment
Hallo Aeschli!
Zum Laufzeitfehler kann ich leider nix sagen, da ich kein Outlook nutze?
Den Pdf-Creater kannst Du in etwa so verwenden:
Grüße Dieter
Zum Laufzeitfehler kann ich leider nix sagen, da ich kein Outlook nutze?
Den Pdf-Creater kannst Du in etwa so verwenden:
ThisWorkbook.Sheets("AB TL").PrintOut , , 1, , "PDFCreater"
Grüße Dieter
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.)
Zum alternativen PDF-Export siehe den Kommentar von Dieter.
Grüße Uwe
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.)
Public Sub TabelleAlsPdf()
Dim olApp As Object
Dim fso As Object
Dim AWS As String
Dim olOldBody As String
Dim strAddress As String
Dim i As Integer
Dim cnt As integer
'Filesystem-Object erzeugen
Set fso = CreateObject("Scripting.FileSystemObject")
' Rem Pfad für PDF festlegen
AWS = "H:\XXX\YYY\AB " & Range("M25") & " " & Range("E14") & ".pdf"
'Falls Datei schon existiert, hänge Nummer an
cnt = 1
While fso.FileExists(AWS)
AWS = fso.GetParentFolderName(AWS) & "\" & fso.GetBaseName(AWS) & "(" & cnt & ")." & fso.GetExtensionName(AWS)
cnt = cnt + 1
Wend
' Bestimmen der E-Mailadresse
strAddress = Range("O19").Value
' Rem Tabelle2 als PDF speichern
ThisWorkbook.Sheets("AB TL").ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
'Email erstellen
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
Set .SendUsingAccount = .Session.Accounts.Item("info@moebelagentur.ch") ' Sendekonto vorwählen
olOldBody = .htmlBody
.To = strAddress
.Subject = "Auftragsbestätigung " & Range("M25") & " - " & Range("J28") ' Betreff
.htmlBody = "<span style=""font-size:11pt; font-family:'calibri'"">" & _
"Sehr geehrte Damen und Herren<br><br>" & _
"Herzlichen Dank für Ihre Bestellung.<br>" & _
"Im Anhang finden Sie die entsprechende Auftragsbestätigung.<br><br>" & _
"Wir bitten Sie die Auftragsbestätigung zu kontrollieren. Ohne Gegenbericht innert 5 Tagen gilt der Auftrag als genehmigt." & olOldBody ' Body. "<br>" = Zeilenumbruchanweisung
.Attachments.Add AWS 'Datei anhängen
.Display
End With
Set olApp = Nothing
Set fso = Nothing
End Sub
Grüße Uwe
Hallo Aeschli!
So sollte es funktionieren:
Grüße Dieter
So sollte es funktionieren:
Public Sub PrintToPdfCreater()
Dim oPdf_Creater As Object, sPdf_Path As String, sPdf_Name As String
sPdf_Path = "H:\XXX\YYY\"
sPdf_Name = "AB " & Range("M25") & " " & Range("E14") 'ohne ".pdf"
Set oPdf_Creater = CreateObject("PDFCreator.clsPDFCreator")
If oPdf_Creater.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Initialisierung von PDFCreator fehlgeschlagen!", vbExclamation, "Fehler"
Exit Sub
End If
With oPdf_Creater
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPdf_Path
.cOption("AutosaveFilename") = sPdf_Name
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ThisWorkbook.Sheets("AB TL").PrintOut Copies:=1, "PDFCreator auf Ne04:" 'Genaue Bezeichnung ermitteln
With oPdf_Creater
Do Until .cCountOfPrintjobs = 1: Loop
.cCombineAll
.cPrinterStop = False
Do Until .cCountOfPrintjobs = 0: Loop
.cClose
End With
Set oPdf_Creater = Nothing
sPdf_Path = sPdf_Path & sPdf_Name & ".pdf"
'Ab hier Uwe's Outlook-Code
End Sub
Grüße Dieter
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.
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...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!!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!
'Filesystem-Object erzeugen
Set fso = CreateObject("Scripting.FileSystemObject")
' Rem Pfad für PDF festlegen
AWS = "H:\XXX\YYY\AB " & Range("M25") & " " & Range("E14") & ".pdf"
'Falls Datei schon existiert, hänge Nummer an
cnt = 1
While fso.FileExists(AWS)
AWS = fso.GetParentFolderName(AWS) & "\" & fso.GetBaseName(AWS) & "(" & cnt & ")." & fso.GetExtensionName(AWS)
cnt = cnt + 1
Wend
Hallo zusammen!
OK, dass hab ich dann komplett übersehen und nur den Druckvorgang berücksichtigt, der bei mir auch einwandfrei funktioniert...
Grüße Dieter
OK, dass hab ich dann komplett übersehen und nur den Druckvorgang berücksichtigt, der bei mir auch einwandfrei funktioniert...
Grüße Dieter
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):
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
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):
ThisWorkbook.Sheets("AB TL").PrintOut Copies:=1, ActivePrinter = "PDFCreator auf Ne04:"
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
Hallo zusammen!
Mit Dateiüberprüfung und gegebenenfalls eine fortlaufende Zahl anhängen:
Grüße Dieter
[edit] Code noch ein weing erweitert, sodass PdfCreater nun auch automatisch erkannt/gesetzt wird... [/edit]
bin noch unterwegs, schaue da heut Abend mal drauf... oder der Dieter vertritt mich
OK, ich versuchs malMit Dateiüberprüfung und gegebenenfalls eine fortlaufende Zahl anhängen:
Option Explicit
Public Sub SendPdfMail()
Dim oFso As Object, oPdf_Creater As Object, olApp As Object
Dim sPdf_Path As String, sPdf_Name As String, sFileName As String, olOldBody As String
Dim sDefaultPrinter As String, iCount As Integer
Set oPdf_Creater = CreateObject("PDFCreator.clsPDFCreator")
If oPdf_Creater.cStart("/NoProcessingAtStartup") = False Then
Set oPdf_Creater = Nothing
MsgBox "Initialisierung von PDFCreator fehlgeschlagen!", vbExclamation, "Fehler"
Exit Sub
End If
sDefaultPrinter = Application.ActivePrinter
If SetPdfPrinter = False Then
Set oPdf_Creater = Nothing
MsgBox "PDFCreator nicht gefunden!", vbExclamation, "Fehler"
Exit Sub
End If
sPdf_Path = "H:\XXX\YYY\"
sPdf_Name = "AB " & Range("M25").Value & " " & Range("E14").Value
With CreateObject("Scripting.FileSystemObject")
sFileName = sPdf_Path & sPdf_Name & ".pdf"
While .FileExists(sFileName)
iCount = iCount + 1
sFileName = sPdf_Path & sPdf_Name & "_" & iCount & ".pdf"
Wend
sPdf_Name = .GetBaseName(sFileName)
End With
With oPdf_Creater
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPdf_Path
.cOption("AutosaveFilename") = sPdf_Name
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ActiveSheet.PrintOut Copies:=1
Application.ActivePrinter = sDefaultPrinter
With oPdf_Creater
Do Until .cCountOfPrintjobs = 1: Loop
.cCombineAll
.cPrinterStop = False
Do Until .cCountOfPrintjobs = 0: Loop
.cClose
End With
Set oPdf_Creater = Nothing
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
Set .SendUsingAccount = .Session.Accounts.Item("info@moebelagentur.ch") ' Sendekonto vorwählen
olOldBody = .htmlBody
.To = Range("O19").Value
.Subject = "Auftragsbestätigung " & Range("M25") & " - " & Range("J28") ' Betreff
.htmlBody = "<span style=""font-size:11pt; font-family:'calibri'"">" & _
"Sehr geehrte Damen und Herren<br><br>" & _
"Herzlichen Dank für Ihre Bestellung.<br>" & _
"Im Anhang finden Sie die entsprechende Auftragsbestätigung.<br><br>" & _
"Wir bitten Sie die Auftragsbestätigung zu kontrollieren. Ohne Gegenbericht " & ´_
"innerhalb von 5 Tagen gilt der Auftrag als genehmigt." & olOldBody
'Body. "<br>" = Zeilenumbruchanweisung
.Attachments.Add sFileName
.Display
End With
Set olApp = Nothing
End Sub
Private Function SetPdfPrinter() As Boolean
Dim sPrinter As String, i As Integer
On Error Resume Next
With Application
For i = 0 To 9
sPrinter = "PDFCreator auf Ne0" & i & ":"
.ActivePrinter = sPrinter
If .ActivePrinter = sPrinter Then
SetPdfPrinter = True: Exit For
End If
Next
End With
On Error GoTo 0
End Function
Grüße Dieter
[edit] Code noch ein weing erweitert, sodass PdfCreater nun auch automatisch erkannt/gesetzt wird... [/edit]