Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1792to1796
1792to1796
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Pfad selber erstellen

Forumthread: 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
Anzeige

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'
Anzeige
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)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige