Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1792to1796
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Pfad selber erstellen

Pfad selber erstellen
26.11.2020 18:39:15
Pierangelo
Hallo Forum
ich habe ein Makro der PDF's selber erstellt und auch speichert.
Nun gibt es eine Fehlermeldung falls einer der Unterordnet nicht existiert.
Was für einen Befehl muss ich eingeben damit das Makro den Ordner selber erstellt falls dieser nicht existiert.
Der Pfad wird per String generiert. Die String (Range) infos stehen in den Zellen Q4 / Q5 / Q6
Q4 = Vordefinierter Pfad
Q5 = Pfad des Unterordners
Q6 = Name der PDF

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
MkDir deinpfad owt
26.11.2020 18:50:17
ralf_b
AW: Pfad selber erstellen
26.11.2020 19:51:37
volti
Hallo Perangelo,
die vorgeschlagene Funktion MKDIR legt einen neuen Unterordner an eine vorhandene Struktur an.
Der gewünschte VorPfad muss aktiv sein, sonst wird der Unterordner ggf. falsch platziert.
Existiert der Unterordner schon, wird ein Fehler rausgegeben. Das sollte also vorher alles abgecheckt werden.
Mit nachfolgender Alternative kannst Du einen Vollpfad anlegen. Auch wenn dieser schon existieren sollte, erfolgt kein Fehlerauswurf.
Code:
[Cc]

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _ ByVal lpPath As String) As Long Sub OrdnerAnlegen() Dim sPath As String sPath = Replace(Range("Q4").value & "\" & Range("Q6").value & "\", "\\", "\") If MakeSureDirectoryPathExists(sPath) = 0 Then MsgBox "Der Ordner " & sPath & " konnte nicht angelegt werden!", _ vbCritical, "Ordner anlegen" End If End Sub

_________________________
viele Grüße aus Freigericht 😊
 

Anzeige
AW: Pfad selber erstellen
26.11.2020 22:30:17
Pierangelo
danke
nun da meine VBA Kenntnisse wirklich Basic sind, ist die Frage wie soll ich den Befehl im mein Makro implementieren, da mein Makro ja Zeile für Zeile ein PDF generiert. Hier ist mein Makro:
Sub SdC_PDF()
' SdC_PDF Makro
Dim DateiName As String
For zeile = 39 To 100000
Wert = Range("K" & zeile)
If Wert  "" Then
Range("J2").FormulaR1C1 = Wert
DateiName = Range("Q4") & Range("Q5") & Range("Q6") & ".pdf"  ' Pfad + Name'
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
DateiName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Else
MsgBox "Tutti i PDF sono stati creati e salvati"
Exit For
End If
Next zeile
End Sub

Anzeige
AW: Pfad selber erstellen
26.11.2020 23:27:45
volti
Hallo,
normalerweise könnte man es so implementieren ...
Aber willst Du wirklich 100.000 Zeilen durchlaufen und bei x Zeilen, wo in Spalte K ein Wert steht, immer wieder die gleiche PDF-Datei zu überschreiben.
Da rate ich Dir, doch noch mal genau zu überlegen, was da jetzt gemacht werden soll.
Code:
[Cc][+][-]

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _ ByVal lpPath As String) As Long Sub SdC_PDF() ' ' SdC_PDF Makro ' Dim DateiName As String, sPfad As String For zeile = 39 To 100000 Wert = Range("K" & zeile) If Wert <> "" Then Range("J2").FormulaR1C1 = Wert sPath = Replace(Range("Q4").Value & "&bsol;" & Range("Q6").Value & "&bsol;", "&bsol;&bsol;", "&bsol;") If MakeSureDirectoryPathExists(sPath) = 0 Then MsgBox "Der Ordner " & sPath & " konnte nicht angelegt werden!", _ vbCritical, "Ordner anlegen" Exit Sub End If DateiName = sPfad & Range("Q6").Value & ".pdf" ' Pfad + Name' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ DateiName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False Else MsgBox "Tutti i PDF sono stati creati e salvati" Exit For End If Next zeile End Sub

_________________________
viele Grüße aus Freigericht 😊
 

Anzeige
AW: Pfad selber erstellen
26.11.2020 23:32:25
volti
Ups,
zwei mal Q6 verwendet..
Code:
[Cc][+][-]

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _ ByVal lpPath As String) As Long Sub SdC_PDF() ' ' SdC_PDF Makro ' Dim DateiName As String, sPfad As String For zeile = 39 To 100000 Wert = Range("K" & zeile) If Wert <> "" Then Range("J2").FormulaR1C1 = Wert sPath = Replace(Range("Q4").Value & "&bsol;" & Range("Q5").Value & "&bsol;", "&bsol;&bsol;", "&bsol;") If MakeSureDirectoryPathExists(sPath) = 0 Then MsgBox "Der Ordner " & sPath & " konnte nicht angelegt werden!", _ vbCritical, "Ordner anlegen" Exit Sub End If DateiName = sPfad & Range("Q6").Value & ".pdf" ' Pfad + Name' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ DateiName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False Else MsgBox "Tutti i PDF sono stati creati e salvati" Exit For End If Next zeile End Sub

_________________________
viele Grüße aus Freigericht 😊
 

Anzeige
AW: Pfad selber erstellen
27.11.2020 00:06:36
Pierangelo
Ciao
Es wird nie die gleiche PDF erstellt, die Daten werden angepasst. Jede Zeile generiert neue Daten.
ja 100'000 ist schon übertrieben, kann es auch auf 250 begrenzen, da normalerweise ca. 100 - 150 zeilen belegt sind.
Versuche dein Vorschlag und geben dann Feedback
AW: Pfad selber erstellen
26.11.2020 23:48:11
volti
Hallo,
hier noch etwas verbessert. Nehmen an, dass der Pfad immer der gleiche ist...
Code:
[Cc][+][-]

Option Explicit Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _ ByVal lpPath As String) As Long Sub SdC_PDF() ' ' SdC_PDF Makro ' Dim sDateiName As String, sPfad As String Dim iZeile As Long, Wert sPfad = Replace(Range("Q4").Value & "&bsol;" & Range("Q5").Value & "&bsol;", "&bsol;&bsol;", "&bsol;") If MakeSureDirectoryPathExists(sPfad) = 0 Then MsgBox "Der Ordner " & sPfad & " konnte nicht angelegt werden!", _ vbCritical, "Ordner anlegen" Exit Sub End If For iZeile = 39 To Cells(Rows.Count, "K").End(xlUp).Row Wert = Range("K" & iZeile) If Wert <> "" Then Range("J2").FormulaR1C1 = Wert sDateiName = sPfad & Range("Q6").Value & ".pdf" ' Pfad + Name' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ sDateiName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False Else MsgBox "Tutti i PDF sono stati creati e salvati" Exit For End If Next iZeile End Sub

_________________________
viele Grüße aus Freigericht 😊
 

Anzeige
AW: Pfad selber erstellen
27.11.2020 08:23:04
Pierangelo
Guten morgen
danke für die verbesserung im Script, die PDF's werden generiert und abgelegt, aber....
Das Makro erstellt nur ein Unterordner und legt alle PDS's dort ab. Es sollten aber mehrere Unterordner eröffnet werden.
Der Wert im Q5 wo teil des Pfades ist kann sich auch ändern. Nur Wert im Q4 ist immer der gleiche.
Habe versucht das Q5 in die untere Zeile des Makro zu nehmen, aber leider funktioniert dies auch nicht:
DateiName = sPfad & Range ("Q5").Value & Range("Q6").Value & ".pdf" ' Pfad + Name'
AW: Pfad selber erstellen
27.11.2020 08:31:29
volti
Moin,
dann nehmen wir den Part wieder in die Schleife, wie vorher..
Da sind dann wohl Formeln drin in den Feldern, das war mir nicht bewusst.
Um Missverständnisse zu vermeiden und überhaupt ein Anliegen besser zu verstehen, ist eine Beispieldatei immer gut...
Code:
[Cc][+][-]

Option Explicit Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _ ByVal lpPath As String) As Long Sub SdC_PDF() ' ' SdC_PDF Makro ' Dim sDateiName As String, sPfad As String Dim iZeile As Long, Wert For iZeile = 39 To Cells(Rows.Count, "K").End(xlUp).Row Wert = Range("K" & iZeile) If Wert <> "" Then Range("J2").FormulaR1C1 = Wert sPfad = Replace(Range("Q4").Value & "&bsol;" & Range("Q5").Value & "&bsol;", "&bsol;&bsol;", "&bsol;") If MakeSureDirectoryPathExists(sPfad) = 0 Then MsgBox "Der Ordner " & sPfad & " konnte nicht angelegt werden!", _ vbCritical, "Ordner anlegen" Exit Sub End If sDateiName = sPfad & Range("Q6").Value & ".pdf" ' Pfad + Name' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ sDateiName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False Else MsgBox "Tutti i PDF sono stati creati e salvati" Exit For End If Next iZeile End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige
AW: Pfad selber erstellen
27.11.2020 09:31:37
Pierangelo
super danke, danke vielmals
das script funktioniert bestens

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige