Ordner anlegen und als PDF speichern
27.04.2016 09:02:11
Rookie
ich habe folgendes Problem und bräuchte eure Hilfe:
Ich möchte mehrere Tabellenblätter als PDF in einem Ordner speichern. Zuerst soll aber geprüft werden ob der Ordner bereits vorhanden ist, falls nicht soll dieser Angelegt werden und anschließend das PDF in diesem Ordner gespeichert werden.
Der Pfad zu diesem Ordner sowie der Dateiname des PDF sollen sich aus einer festen Vorgabe und verschiedenen Zelleninhalten der aktiven Tabelle generieren.
Leider funktioniert es bei mir nicht. Es kommt die Meldung Fehler beim Zugriff auf Pfad/Datei.
Vielleicht kann mir einer von euch weiterhelfen.
Vielen herzlichen Dank im voraus!
Option Explicit
Sub PrüfenAnlegenPDFspeichern()
Dim Pfad As String
Dim Name As String
Dim Datei As String
Dim Endpfad As String
Pfad = "R:\kst128000\individual\Audits\" & Name 'Grundpfad
With ActiveSheet
Name = .Cells(3, 8).Value & "\" & .Cells(7, 18).Value & "\" & .Cells(4, 8).Value & " " & _
.Cells(6, 8).Value 'Namen der Unterordner
Datei = "\" & .Cells(7, 23).Value & "_" & .Cells(5, 8).Value & ".pdf" ' Dateiname PDF
End With
If Dir(Pfad, vbDirectory) = Name Then
MsgBox "Das Verzeichnis existiert bereits!"
Else
MkDir Pfad
MsgBox "Verzeichnis erstellt."
End If
Endpfad = Pfad & Name & Datei
MsgBox "Verzeichnis " & Endpfad
Sheets(Array("Deckblatt Q-Fähigk ", "Proz-BalkenMatrix", "Bewertungsmatrix", _
"QTP dt.", "Maßnahmenplan")).Select
Sheets("Maßnahmenplan").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Endpfad, Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub