VBA - nadpisywanie funkcji Dir w pętli

0

Cześć mam pytanie jak można ominąć to, że używanie polecenia Dir po raz drugi nadpisuje ścieżkę na której ona działa po raz pierwszy.
Zależy mi na tym, żeby ścieżka z pierwszego Dir'a była pamiętana i później jak chcę przy użyciu tego polecenia wyszukać kolejny plik to, żeby przeszukiwało to odpowiedni folder z pierwszej ściezki.
Trzeba dodać, że te polecenia znajdują się w pętli i dlateg owystępuje u mnie taki problem.

Poniżej zamieszczam kod i z góry dzięki za wszelkie odpowiedzi :)

Function BrowseFolder(Optional Caption As String, _
    Optional InitialFolder As String) As String

Dim SH As Shell32.Shell
Dim F As Shell32.Folder

Set SH = New Shell32.Shell
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
If Not F Is Nothing Then
    BrowseFolder = F.Items.Item.Path
End If

End Function
'*****TUTAJ ZACZYNA SIĘ KOD POWYŻEJ JEST FUNKCJA WYBIERAJĄCA FOLDER Z KTÓREGO ZACIĄGA PLIKI I POTEM WYBIERA SIĘ FOLDER DOCELOWY*****
Sub main()

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swPart          As SldWorks.PartDoc
Dim sFileName       As String
Dim Path            As String
Dim nErrors         As Long
Dim nWarnings       As Long
Dim Part            As Object
Dim Longstatus      As Long
Dim Nazwa           As String
Dim NazwaZamykanie1 As String
Dim NazwaZamykanie2 As String
Dim swModelTitle    As SldWorks.ModelDoc2
Dim vTitle          As Variant
Dim PathSize        As Long
Dim PathNoExtention As String
Dim FilePath        As String
Dim Path2           As String
Dim Rozszerzenie    As String
Dim SLDDRW          As String
Dim NowaSciezka2    As String


Set swApp = Application.SldWorks
   
Path = BrowseFolder(Caption:="Select A Folder/Path")

    If Path = "" Then
        MsgBox "Please select the path and try again"
        End
    Else
        Path = Path & "\"
    End If
    
sFileName = Dir(Path)  '****PIERWSZY DIR
   
Path2 = BrowseFolder(Caption:="Select A Folder/Path")
    If Path2 = "" Then
        MsgBox "Please select the path and try again"
        End
    Else
        Path2 = Path2 & "\"
    End If
  
'*******TUTAJ SIĘ ZACZYNA PROBLEM *******

Do Until sFileName = ""
    Rozszerzenie = Right(sFileName, 6)
    SLDDRW = "SLDDRW"
If StrComp(Rozszerzenie, SLDDRW, vbTextCompare) = 0 Then
    Set swModel = swApp.OpenDoc6(Path + sFileName, 3, swOpenDocOptions_Silent, "", nErrors, nWarnings)
    Set swPart = Nothing
    Set swModelTitle = swApp.GetOpenDocument(vTitle): Debug.Assert Not swModelTitle Is Nothing
    Set Part = swApp.ActiveDoc
    
    Nazwa = Path2 & swModelTitle.GetTitle & ".pdf"
        If Dir(Nazwa) <> "" Then        '*********TUTAJ DRUGI DIR *************
            Do Until Dir(NowaSciezka2) = ""
                MsgBox "Ta nazwa ju¿ jest w folderze. W kolejnym oknie wpisz koñcówkê inn¹ np -1"
                NowaSciezka2 = Path2 & swModelTitle.GetTitle & InputBox("Wpisz koñcówke") & ".pdf"
            Loop
        Longstatus = Part.SaveAs3(NowaSciezka2, 0, 0)
        FilePath = Part.GetPathName
        PathSize = Strings.Len(FilePath)
        PathNoExtention = Strings.Left(FilePath, PathSize - 7)
        PathSize = Strings.Len(Path)
        NazwaZamykanie1 = Mid(PathNoExtention, PathSize + 1)
        NazwaZamykanie2 = NazwaZamykanie1 & " " & "- Arkusz1"
        Else
        Longstatus = Part.SaveAs3(Nazwa, 0, 0)
        FilePath = Part.GetPathName
        PathSize = Strings.Len(FilePath)
        PathNoExtention = Strings.Left(FilePath, PathSize - 7)
        PathSize = Strings.Len(Path)
        NazwaZamykanie1 = Mid(PathNoExtention, PathSize + 1)
        NazwaZamykanie2 = NazwaZamykanie1 & " " & "- Arkusz1"
        End If
    
    swApp.CloseDoc NazwaZamykanie2
    sFileName = Dir   '******* TO POLECENIE PRZECZYTUJE JUŻFOLDER GDZIE MAJA BYC ZAPISYWANE PLIKI A NIE TEN SKAD ZACIAGA PLIKI
    Else
        sFileName = Dir   '******* TO POLECENIE PRZECZYTUJE JUŻFOLDER GDZIE MAJA BYC ZAPISYWANE PLIKI A NIE TEN SKAD ZACIAGA PLIKI
    End If
    Loop
End Sub
0

Dir z parametrem wykonujesz raz, potem bez parametrów. I wynik zapisujesz do zmiennej.

0

Nie rozumiem, czemu mam kolejne DIry brać bez parametru skoro one muszą przeszukiwac całkiem inną lokalizację?
Dir do sFileName przeszukuje 1-szą lokalizację a Dir do Nazwy drugśą lokalizację.
Jeśli w tym drugim nie podam tej ściezki to skąd on ma wiedzieć, że tam musi wykonać jakąś czynność ?
Chce zaznaczyć, że niedawno zacząłem poznawać VBA nie mając wcześniej doświadczenia z programowania i nie wszystko jest dla mnie jeszcze tak oczywiste :)

Poniżej wycinki tego o czym mówię:

sFileName = Dir(Path) 'TUTAJ PIERWSZA SCIEZKA

Nazwa = Path2 & swModelTitle.GetTitle & ".pdf" 'TO JEST DRUGA SCIEZKA
        If Dir(Nazwa) <> "" Then        '*********TUTAJ DRUGI DIR *************
            Do Until Dir(NowaSciezka2) = ""
                MsgBox "Ta nazwa ju¿ jest w folderze. W kolejnym oknie wpisz koñcówkê inn¹ np -1"
                NowaSciezka2 = Path2 & swModelTitle.GetTitle & InputBox("Wpisz koñcówke") & ".pdf"
            Loop
0

Bo dir działa tak, że wywołanie z parametrem powoduje przeszukiwanie pliku wg. parametru i później dir bez parametru zwraca kolejny plik.
więc nie możesz używać jednoczesnie dir do iteracji po plikach i sprawdzania czy plik istnieje.
Najprościej napisać funkcje:

Function FileExists(FilePath) as Boolean
  Set fso = CreateObject("Scripting.FileSystemObject")
   FileExists = fso.FileExists(FilePath)
   set fso = Nothing
End Function

i użyć jej w tej pętli:

Do While FileExists(NowaSciezka2)
    MsgBox "Ta nazwa ju¿ jest w folderze. W kolejnym oknie wpisz koñcówkê inn¹ np -1"
    NowaSciezka2 = Path2 & swModelTitle.GetTitle & InputBox("Wpisz koñcówke") & ".pdf"
Loop

1 użytkowników online, w tym zalogowanych: 0, gości: 1