PDF PrintOut-Problem

Ich habe nachfolgende Prozedur geschrieben, welche ein Excel-Dokument als PDF-Datei ausdruckt. Diese Prozedur funktioniert wunderbar nur mit dem Problem, dass die PDF-Datei nicht ins selbe Verzeichnis geschrieben wird wie die Excel Datei (Die Excel Datei befindet sich im Verzeichnis H:\Daten, doch die PDF-Datei landet im Verzeichnis H:\). Ich wäre sehr um einen Tipp dankbar.

Tom

Public Sub Print_to_PDF(ws As Worksheet)

Dim objTmpPDF As Object
Dim strFileName As String

'Dateiname bestimmen
strFileName = Left(ws.Parent.FullName, Len(ws.Parent.FullName) - 4)

'Objekt für Dummy-File
Set objTmpPDF = CreateObject("Scripting.FileSystemObject")

'Dokument ausdrucken
ws.PrintOut _
Copies:=1, _
ActivePrinter:="Acrobat PDFWriter auf LPT1:", _
PrintToFile:=True, _
PrToFilename:=strFileName

'Dummy löschen
objTmpPDF.deletefile strFileName

End Sub

bringt alles nichts. Der PDF-Writer erzeugt automatisch die PDF-Endung und schreibt ein Dummy Objekt ins korrekte Verzeichnis, jedoch die PDF-Datei ins CurDir Verzeichnis. Ich habe sicherheitshalber ein FileCopy-Befehl eingefügt, doch überzeugen tut mich das nicht. Nachfolgend der neue Code:

Public Sub Print_to_PDF(ws As Worksheet)

Dim objTmpPDF As Object
Dim strFileName As String
Dim aFolders(3) As String
Dim intCounter As Integer

aFolders(1) = ws.Parent.Path
aFolders(2) = Application.DefaultFilePath
aFolders(3) = CurDir

'Dateiname bestimmen
strFileName = Left(ws.Parent.Name, Len(ws.Parent.Name) - 4)

'sicherheitshalber alte Dateien löschen
For intCounter = 1 To 3
If Dir(aFolders(intCounter) & "\" & strFileName & ".pdf") <> "" Then
Kill aFolders(intCounter) & "\" & strFileName & ".pdf"
End If
Next intCounter

'Objekt für Dummy-File
Set objTmpPDF = CreateObject("Scripting.FileSystemObject")

'Dokument ausdrucken (wichtig ohne PDF-Endung!)
ws.PrintOut _
ActivePrinter:="Acrobat PDFWriter auf LPT1:", _
PrintToFile:=True, _
PrToFilename:=ws.Parent.Path & "\" & strFileName

'Dummy-Objekt löschen
objTmpPDF.deletefile ws.Parent.Path & "\" & strFileName

'falls Datei ins falsche Verzeichnis kopiert wurde, korrigieren
For intCounter = 2 To 3
If aFolders(intCounter) <> ws.Parent.Path Then
If Dir(aFolders(intCounter) & "\" & strFileName & ".pdf") <> "" Then
On Error Resume Next
FileCopy aFolders(intCounter) & "\" & strFileName & ".pdf", _
ws.Parent.Path & "\" & strFileName & ".pdf"

If Err.Number = 0 Then
Kill aFolders(intCounter) & "\" & strFileName & ".pdf"
End If
On Error GoTo 0
End If
End If
Next intCounter

End Sub

Forumthread: PDF PrintOut-Problem

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

PDF PrintOut-Problem

Forumthread: PDF PrintOut-Problem

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread