aktuellen Pfad

aktuellen Pfad

03.01.2025 17:54:06

sigrid

Hallo zusammen,
ich habe ein kleines Problem.
Allen nochmals ein gesundes neues Jahr !

Ich würde gern, nachdem der vorgegebenen Pfad Verzeichnis für
Jahr, Monat erstellt wurde, läuft perfekt, möchte ich dann im aktuellen Monat
ein neues Verzeichnis erstellen "PDF".

strPath = "D:\__Rechnungen\" & RgOrt

DateiNam = WBN & "  " & "Rg.-Nr. " & ActiveSheet.Range("D24") & " " & ActiveSheet.Range("F23") & ".xlsm"

 ActiveSheet.Application.ScreenUpdating = False



With ActiveSheet                       

    If IsDate(.Range("H29")) Then

        If .Range("H29") > 0 Then

            'Pfad Jahr

            strPath = strPath & Year(.Range("H29").value) & "\"

            'Pfad Monat

            strPath = strPath & Format(.Range("H29").value, "MM  MMMM") & "\"

            'Ordner erstellen sollte dieser nicht vorhanden sein

            apiCreateFullPath strPath

            'Pfad Dateiname

            strPath = strPath & DateiNam

            

            'Prüfung ob vorhanden

           If Dir(strPath, vbNormal) > "" Then

                MsgBox "Kunden-Name " & DateiNam & Chr(13) & Chr(13) & _

                    "mit der Rg. - Nr. ist vorhanden !" & vbLf & vbLf & "Bitte ändern !"

                Application.DisplayAlerts =True

   End If

        strPath = "???" & "\PDF"

        If Dir$(strPath, vbDirectory) = vbNullString Then

                '  MsgBox "Die ausgewählte Datei existiert nicht"

                MkDir strPath

        End If

            End If

                End If

würde mich für eine Lösung freuen.
gruß sigrid

AW: aktuellen Pfad

03.01.2025 18:54:36

Onur

Du hast doch schon den Pfad, aber überschreibst ihn hinterher - warum?
Mach es so:

         .....

         'strPath = strPath & DateiNam

         'Prüfung ob vorhanden

         If Dir(strpath & DateiNam, vbNormal) > "" Then

            MsgBox "Kunden-Name " & DateiNam & Chr(13) & Chr(13) & _

            "mit der Rg. - Nr. ist vorhanden !" & vbLf & vbLf & "Bitte ändern !"

            Application.DisplayAlerts = True

         End If

         strPath = strpath & "PDF"

         .....

Wo ist das END WITH zu dem WITH ?

AW: aktuellen Pfad

03.01.2025 19:34:22

sigrid

Guten Abend Onur,
leider wird der Ordner "PDF" im Verzeichnis 1 Januar nicht erstellt.

Dim WBName As String

    WBName = Tabelle1.Range("P32")



Dim DateiNam As String

Dim aDatei As String

Dim strPath$

Dim akt As String





strPath = "D:\__Rechnungen\" & RgOrt



DateiNam = WBName & "  " & "Rg.-Nr. " & ActiveSheet.Range("D24") & " " & ActiveSheet.Range("F23") & ".xlsm"



 ActiveSheet.Application.ScreenUpdating = False

   ' MsgBox DateiNam

   ' MsgBox strPath



With ActiveSheet                        'Tabelle anpassen

    If IsDate(.Range("H29")) Then

        If .Range("H29") > 0 Then

            'Pfad Jahr

            strPath = strPath & Year(.Range("H29").value) & "\"

            'Pfad Monat

            strPath = strPath & Format(.Range("H29").value, "MM  MMMM") & "\"

            'Ordner erstellen sollte dieser nicht vorhanden sein

            apiCreateFullPath strPath

            'Pfad Dateiname

            strPath = strPath & DateiNam

   

         If Dir(strPath & DateiNam, vbNormal) > "" Then

            MsgBox "Kunden-Name " & DateiNam & Chr(13) & Chr(13) & _

            "mit der Rg. - Nr. ist vorhanden !" & vbLf & vbLf & "Bitte ändern !"

            Application.DisplayAlerts = True

         End If

         

         strPath = strPath & "PDF"

        End If

        End If

         

        End With

         Exit Sub

gruß sigrid

AW: aktuellen Pfad

03.01.2025 19:50:46

Onur

DAS ist ja auch nicht, was ich dir gepostet habe.

strPath = strPath & DateiNam

war bei mir doch ausapostrophiert (muss weg).

Sorry ich meinte natürlich einen Ordner !

03.01.2025 19:01:43

sigrid

AW: Sorry ich meinte natürlich einen Ordner !

03.01.2025 19:06:53

Onur

Verzeichnis und Ordner ist das SELBE.

AW: Sorry ich meinte natürlich einen Ordner !

03.01.2025 19:58:10

sigrid

Hallo Onur,
so wird auch kein Ordner "PDF" erstellt.
Allerdings der Dateiname als Ordner.

With ActiveSheet                        'Tabelle anpassen

    If IsDate(.Range("H29")) Then

        If .Range("H29") > 0 Then

            'Pfad Jahr

            strPath = strPath & Year(.Range("H29").value) & "\"

            'Pfad Monat

            strPath = strPath & Format(.Range("H29").value, "MM  MMMM") & "\"

            'Ordner erstellen sollte dieser nicht vorhanden sein

            apiCreateFullPath strPath

            'Pfad Dateiname

            strPath = strPath & DateiNam

            

            'Prüfung ob vorhanden

          ' If Dir(strPath, vbNormal) > "" Then

            '    MsgBox "Kunden-Name " & DateiNam & Chr(13) & Chr(13) & _

            '        "mit der Rg. - Nr. ist vorhanden !" & vbLf & vbLf & "Bitte ändern !"

               ' strPath = ActiveWorkbook.FullName

               ' On Error Resume Next

             '   Application.DisplayAlerts = False

             ''   ActiveWorkbook.Close ''True

             '    Kill strPath

                   ' ActiveWindow.Close

         If Dir(strPath & DateiNam, vbNormal) > "" Then

            MsgBox "Kunden-Name " & DateiNam & Chr(13) & Chr(13) & _

            "mit der Rg. - Nr. ist vorhanden !" & vbLf & vbLf & "Bitte ändern !"

            Application.DisplayAlerts = True

         End If

      End If

          End If

      End With

    If Dir$(strPath, vbDirectory) = vbNullString Then

      '  MsgBox "Die ausgewählte Datei existiert nicht"

      '  MsgBox strFolder

        MkDir strPath

    Else

    End If

         Exit Sub

gruß sigrid

AW: Sorry ich meinte natürlich einen Ordner !

03.01.2025 20:02:15

Onur

Zum ZWEITEN Mal:

 strPath = strPath & DateiNam

MUSS weg!

Uff... -)

03.01.2025 20:15:56

sigrid

Herzlichen Dank Onur,
so wird der Ordner im Januar "PDF" erstellt.
Dank.

With ActiveSheet                        'Tabelle anpassen

    If IsDate(.Range("H29")) Then

        If .Range("H29") > 0 Then

            'Pfad Jahr

            strPath = strPath & Year(.Range("H29").value) & "\"

            'Pfad Monat

            strPath = strPath & Format(.Range("H29").value, "MM  MMMM") & "\"

            'Ordner erstellen sollte dieser nicht vorhanden sein

            apiCreateFullPath strPath

          

            'Pfad Dateiname

         ''''''   strPath = strPath & DateiNam

      

         If Dir(strPath & DateiNam, vbNormal) > "" Then

            MsgBox "Kunden-Name " & DateiNam & Chr(13) & Chr(13) & _

            "mit der Rg. - Nr. ist vorhanden !" & vbLf & vbLf & "Bitte ändern !"

            Application.DisplayAlerts = True

         End If

      End If

          End If

      End With

        

         strPath = strPath & "\PDF"

      If Dir$(strPath, vbDirectory) = vbNullString Then

      '  MsgBox "Die ausgewählte Datei existiert nicht"

        MkDir strPath

    Else

    End If

      Exit Sub

schönen Abend noch !
gruß sigrid

Gerne !

03.01.2025 20:17:54

Onur

Schwere Geburt !

Sorry, ich kann die Datei nicht in den Monat speichern

03.01.2025 20:29:58

sigrid

Hallo Onur,
ich kann allerdings nicht die Datei in den Monat speichern.
Der Ordner "PDF" wird für später gebraucht.

Dim WBName As String

    WBName = Tabelle1.Range("P32")          'Name der Datei



Dim DateiNam As String

Dim aDatei As String

Dim strPath$

Dim akt, p As String

Dim strpathp



strPath = "D:\__Rechnungen\" & RgOrt



DateiNam = WBName & "  " & "Rg.-Nr. " & ActiveSheet.Range("E24") & " " & ActiveSheet.Range("D23") & ".xlsm"



 ActiveSheet.Application.ScreenUpdating = False



With ActiveSheet                        'Tabelle anpassen

    If IsDate(.Range("H29")) Then

        If .Range("H29") > 0 Then

            'Pfad Jahr

            strPath = strPath & Year(.Range("H29").value) & "\"

            'Pfad Monat

            strPath = strPath & Format(.Range("H29").value, "MM  MMMM") & "\"

            'Ordner erstellen sollte dieser nicht vorhanden sein

            apiCreateFullPath strPath

          

            'Pfad Dateiname

         '''' strPath = strPath & DateiNam

      

         If Dir(strPath & DateiNam, vbNormal) > "" Then

            MsgBox "Kunden-Name " & DateiNam & Chr(13) & Chr(13) & _

            "mit der Rg. - Nr. ist vorhanden !" & vbLf & vbLf & "Bitte ändern !"

            Application.DisplayAlerts = True

         End If

      End If

          End If

      End With

        

         strPath = strPath & "\PDF"

      If Dir$(strPath, vbDirectory) = vbNullString Then

      

        MkDir strPath

    Else

    

    End If

    

      ActiveWorkbook.SaveCopyAs Filename:=DateiNam

      

     ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _

           :=True, Password:=getStrPassWort                                      'schützen

mfg sigrid

AW: Sorry, ich kann die Datei nicht in den Monat speichern

03.01.2025 20:36:03

Onur

DAS musst du natürlich auch ändern:

ActiveWorkbook.SaveCopyAs Filename:=strPath  &  "\" & DateiNam

AW: Sorry, ich kann die Datei nicht in den Monat speichern

03.01.2025 20:51:42

sigrid

Hallo Onur,
ich weiß ich bin eine Nervensäge aber jetzt wird die Datei im Ordner "PDF" gespeichert.

SORRRRRYYYY,
sigrid

AW: Sorry, ich kann die Datei nicht in den Monat speichern

03.01.2025 20:57:13

Onur

Dann muss das

 ActiveWorkbook.SaveCopyAs Filename:=strPath & DateiNam

direkt VOR

strPath = strPath & "\PDF"

stehen.

AW: Sorry, ich kann die Datei nicht in den Monat speichern

03.01.2025 21:08:35

Onur

Kann sein, dass du noch einen Backslash dazwischen quetschen:

 ActiveWorkbook.SaveCopyAs Filename:=strPath & "\" & DateiNam

Fehlermeldung

03.01.2025 21:11:20

sigrid

Hallo Onur,
leider Fehlermeldung.
Ich kann ja nochmal morgen nachfragen, möchte Dich nicht stressen.

Dim WBName As String

    WBName = Tabelle1.Range("P32")          'Name der Datei



Dim DateiNam As String

Dim aDatei As String

Dim strPath$

Dim akt, p As String

Dim strpathp



strPath = "D:\__Rechnungen\" & RgOrt



DateiNam = WBName & "  " & "Rg.-Nr. " & ActiveSheet.Range("H24") & " " & ActiveSheet.Range("E23") & ".xlsm"



 'ActiveSheet.Application.ScreenUpdating = False

 'ActiveWorkbook.SaveCopyAs Filename:=DateiNam

 



With ActiveSheet                        'Tabelle anpassen

    If IsDate(.Range("H29")) Then

        If .Range("H29") > 0 Then

            'Pfad Jahr

            strPath = strPath & Year(.Range("H29").value) & "\"

            'Pfad Monat

            strPath = strPath & Format(.Range("H29").value, "MM  MMMM")   ' & "\"

            'Ordner erstellen sollte dieser nicht vorhanden sein

            apiCreateFullPath strPath

          

            'Pfad Dateiname

         '''' strPath = strPath & DateiNam

 

         If Dir(strPath & DateiNam, vbNormal) > "" Then

            MsgBox "Kunden-Name " & DateiNam & Chr(13) & Chr(13) & _

            "mit der Rg. - Nr. ist vorhanden !" & vbLf & vbLf & "Bitte ändern !"

            Application.DisplayAlerts = True

         End If

      

      End If

          End If

      End With

  

      ActiveWorkbook.SaveCopyAs Filename:=strPath & "\" & DateiNam

    

         strPath = strPath & "PDF"

      If Dir$(strPath, vbDirectory) = vbNullString Then

        MkDir strPath

    Else

    End If

  End Sub

mfg sigrid

AW: Fehlermeldung

03.01.2025 21:13:52

Onur

WELCHE denn ?

AW: Fehlermeldung

03.01.2025 21:15:11

Onur

Und WO genau?

AW: Fehlermeldung

03.01.2025 21:17:28

Onur

Ausserdem:
Poste doch endlich mal das ganze Makro statt jedesmal einen anderen Aussschnitt davon.

koml.Makro

03.01.2025 21:22:13

sigrid

Hallo Onur,
das koml.Makro, habe jetzt anderen Ordner genommen aber auch Fehlermeldung.

Public Sub Speichern_D()



Dim WBName As String

    WBName = Tabelle1.Range("P32")          'Name der Datei



Dim DateiNam As String

Dim aDatei As String

Dim strPath$

Dim akt, p As String

Dim strpathp



strPath = "D:\__Dokumente.Buchhaltung\" & RgOrt



DateiNam = WBName & "  " & "Rg.-Nr. " & ActiveSheet.Range("H24") & " " & ActiveSheet.Range("E23") & ".xlsm"



With ActiveSheet                        'Tabelle anpassen

    If IsDate(.Range("H29")) Then

        If .Range("H29") > 0 Then

            'Pfad Jahr

            strPath = strPath & Year(.Range("H29").value) & "\"

            'Pfad Monat

            strPath = strPath & Format(.Range("H29").value, "MM  MMMM")   ' & "\"

            'Ordner erstellen sollte dieser nicht vorhanden sein

            apiCreateFullPath strPath

          

            'Pfad Dateiname

         '''' strPath = strPath & DateiNam

 

         If Dir(strPath & DateiNam, vbNormal) > "" Then

            MsgBox "Kunden-Name " & DateiNam & Chr(13) & Chr(13) & _

            "mit der Rg. - Nr. ist vorhanden !" & vbLf & vbLf & "Bitte ändern !"

            Application.DisplayAlerts = True

         End If

      End If

          End If

      End With

      ActiveWorkbook.SaveCopyAs Filename:=strPath & "\" & DateiNam

         strPath = strPath & "PDF"

      If Dir$(strPath, vbDirectory) = vbNullString Then

      

        MkDir strPath

    Else

    End If

  End Sub

mfg sigrid

AW: koml.Makro

03.01.2025 21:29:33

Onur

Ist denn in diesem Ordner evtl die gleiche Datei bereits vorhanden?

AW:Nein nirgendwo vorhanden

03.01.2025 21:32:33

Sigrid

AW: AW:Nein nirgendwo vorhanden

04.01.2025 00:24:34

Onur

Bringt so nicht viel - kannst du die Datei posten? Sensible Daten kannst du ja verändern in "Max Mustermann" o.Ä. .

Geht nicht -)

04.01.2025 12:29:03

sigrid

Guten Morgen Onur,
ich kann Dir nicht die Orginal-Datei senden, ist vom Kollegen.
Danke für deine Geduld !
Habe mal das alte Makro (ist vom Kollen) das läuft einwandfrei.
Ich hatte das neuere Makro erstellt, da es "schneller" gehen sollte.

mfg sigrid

Forumthread: aktuellen Pfad

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

aktuellen Pfad

Forumthread: aktuellen Pfad

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread