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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread