• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 459
  • Last Modified:

Looping through nested directories in VB6

I need to loop through nested directories to search for and replace files.  Basically I want to:

1.  Look for the file in the directory that's given to me in a textbox, and if it's there replace it.
2.  Determine if there are any subdirectories in the given directory.
3.  If there are subdirectories, search for the file and replace.
4.  Repeat steps 2-3 up to four times.

Here is the code I have so far:

sDir = Dir$(txtDir.Text & "\" & txtFile.Text)

If Len(sDir) > 0 Then
  FileCopy sFileLocation, txtDir.Text & "\" & txtDir.Text
End If

sDir = Dir$(txtDir.Text & "\", vbDirectory)

While Len(sDir) <> 0
  If sDir = "." Then
    GoTo SkipDir
  End If
  If sDir = ".." Then
    GoTo SkipDir
  End If
 
  sDir1 = Dir$(txtDir.Text & "\" & sDir & "\" & txtFile.Text)
 
  If Len(sDir1) > 0 Then
    FileCopy sFileLocation, txtDir.Text & "\" & sDir & "\" & sDir1
  End If
 
  sDir1 = Dir$(txtDir.Text & "\" & sDir & "\", vbDirectory)
 
  While Len(sDir1) <> 0
    If sDir1 = "." Then
      GoTo SkipDir1
    End If
    If sDir1 = ".." Then
      GoTo SkipDir1
    End If
   
    sDir2 = Dir$(txtDir.Text & "\" & sDir & "\" & sDir1 & "\" & txtFile.Text)
 
    If Len(sDir2) > 0 Then
      FileCopy sFileLocation, txtDir.Text & "\" & sDir & "\" & sDir1 & "\" & sDir2
    End If
   
    sDir2 = Dir$(txtDir.Text & "\" & sDir & "\" & sDir1 & "\", vbDirectory)
   
    While Len(sDir2) <> 0
      If sDir2 = "." Then
        GoTo SkipDir2
      End If
      If sDir2 = ".." Then
        GoTo SkipDir2
      End If
     
      sDir3 = Dir$(sDir2 & "\" & txtFile.Text)
   
      If Len(sDir3) > 0 Then
        FileCopy sFileLocation, txtDir.Text & "\" & sDir & "\" & sDir1 & "\" & sDir2 & "\" & sDir3
      End If
     
      sDir3 = Dir$(txtDir.Text & "\" & sDir & "\" & sDir1 & "\" & sDir2 & "\", vbDirectory)
     
      While Len(sDir3) <> 0
        If sDir3 = "." Then
          GoTo SkipDir3
        End If
        If sDir3 = ".." Then
          GoTo SkipDir3
        End If
       
        sDir4 = Dir$(sDir3 & "\" & txtFile.Text)
     
        If Len(sDir4) > 0 Then
          FileCopy sFileLocation, txtDir.Text & "\" & sDir & "\" & sDir1 & "\" & sDir2 & "\" & sDir3 & "\" & sDir4
        End If
       
SkipDir3:
        sDir3 = Dir$
      Wend
SkipDir2:
      sDir2 = Dir$
    Wend
SkipDir1:
    sDir1 = Dir$
  Wend
SkipDir:
  sDir = Dir$
Wend


The problem I run into is after the "." and ".." directories are skipped.  If there is not a subdirectory, I get a "Run time error '5'" on the "sDir1=Dir$" line of my code.  What am I missing?
0
jtminton
Asked:
jtminton
  • 3
  • 2
  • 2
  • +1
1 Solution
 
PePiCommented:
Have you tried looking at FileSystemObject? If the file is found in the folder, replace it with what? How do you determine the destination forlder when you do a filecopy? can you provide a more concrete example?
0
 
jtmintonAuthor Commented:
It's for updating shortcuts in user directories.  Instead of copying and pasting in each and every one, I am writing a program to do it automatically.  I have a form that has a textbox to put in the directory to look in for the shortcuts (users, group templates, etc) and a textbox with a browse button that calls the Common Dialog box to find the .lnk file that needs to be copied.  So basically, they select the location to look, select the file to replace any found files with and click "Update".  Is that what you need to know?
0
 
PePiCommented:
Ok, I just want to be sure if I get this right...

1. They select a location as to where the file is
2. They then select the (.lnk) file
3. When they click "Update", the selected file is to be copied where?

Ex. If there is a file called test.lnk in folder TEST with sub folders A, B & C. File test.lnk is also in subfolder B. What would be the result after hitting the "Update" button?

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
rettiseertCommented:
'Try this, just add a referencie to Microsoft Scripting Runtime (Project -> References...)

Private Sub ReplaceFile(DirectoryToStart As String, FileToReplace As String, NewFile As String, Depth As Long)

    Dim fso As New FileSystemObject
    Dim startdir As Folder
    Dim subdir As Folder
    Dim f As File
   
    If Depth = 0 Then Exit Sub
   
    Set startdir = fso.GetFolder(DirectoryToStart)
   
    For Each subdir In startdir.SubFolders
        ReplaceFile subdir.Path, FileToReplace, NewFile, Depth - 1
    Next
   
    For Each f In startdir.Files
        If f.Name = FileToReplace Then
            FileCopy NewFile, f.Path
        End If
    Next

End Sub
0
 
jtmintonAuthor Commented:
Let me clarify for Pepi:

They put the destination directory into a textbox, meaning WHERE the .lnk is going to go.

There is a master shortcut folder on a different drive that the .lnk file is coming FROM.

So, they enter where they want the file to go, and the file that will replace it is selected from the master folder via the common dialog box.  When the program loops through the WHERE directory and subdirectories, it will replace any instance of the .lnk file it finds with a copy of the one in the master folder.

Make sense?
0
 
jtmintonAuthor Commented:
For rettiseert:

Will the example you gave:

    For Each subdir In startdir.SubFolders
        ReplaceFile subdir.Path, FileToReplace, NewFile, Depth - 1
    Next

work if the subdirectories have subdirectories, or will additional loops have to be run in order for that to work?  For example, if directory "Top" has subdirectories "Middle1" and "Middle2", and "Middle2" has subdirectories "Bottom1" and "Bottom2", will running the above loop take care of all of them at once?
0
 
rettiseertCommented:
Hi

This will work with subdirectories too, no need for extra loops, just paste the entire sub in your form code.

For  example, to replace all files named "File.lnk" inside "C:\Dir" (and up to 4 subdirectories below) with another file located in "C:\My documents\File.lnk"  you need to call the sub this way:

ReplaceFile "C:\Dir", "File.lnk", "C:\My documents\File.lnk", 4
0
 
Tommy KinardCommented:
Hi jtminton,

Just in case some else's doesn't work:
Private Sub Command1_Click()
    Dim MyInfo As String
    Dim MyList() As String
    Dim SubMyList() As String
    Dim I As Long
    Dim N As Long
    Dim J As Long
    Dim Q As Long
    ReDim MyList(0)
    ReDim SubMyList(0)
    If Right(Text1.Text, 1) <> "\" Then Text1.Text = Text1.Text & "\"
    LookForSubDir Text1.Text, MyList
    N = 1
    For Q = 1 To 3
        ReDim SubMyList(0)
        For I = N To UBound(MyList)
            LookForSubDir MyList(I), SubMyList
        Next
        J = 1
        N = UBound(MyList) + 1
        For I = N To UBound(MyList) + UBound(SubMyList)
            ReDim Preserve MyList(I)
            MyList(I) = SubMyList(J)
            J = J + 1
        Next
    Next
    If Right(Text3.Text, 1) <> "\" Then Text3.Text = Text3.Text & "\"
    For I = 1 To UBound(MyList)
        LookForFile Text3.Text, Text2.Text, MyList(I)
    Next
End Sub
Sub LookForFile(iFilePath As String, iFileName As String, iLookInDir As String)
    Dim mThisPath As String
    Dim mMoreInfo As String
    Dim mLookingIn As String
    mThisPath = iFilePath
    mLookingIn = iLookInDir
    If Right(mThisPath, 1) <> "\" Then mThisPath = mThisPath & "\"
    If Right(mLookingIn, 1) <> "\" Then mLookingIn = mLookingIn & "\"
    mMoreInfo = Dir(mLookingIn & iFileName)
    If mMoreInfo <> vbNullString Then
        FileCopy mThisPath & iFileName, mLookingIn & iFileName
    End If
End Sub
Sub LookForSubDir(iLookIn As String, arrDirs() As String)
    Dim MyInfo As String
    Dim I As Long
    MyInfo = Dir(iLookIn, vbDirectory)
    While MyInfo <> vbNullString
        MyInfo = Dir
        If (GetAttr(iLookIn & "\" & MyInfo) And vbDirectory) = vbDirectory _
          And MyInfo <> ".." And MyInfo <> "." And MyInfo <> vbNullString Then
            ReDim Preserve arrDirs(UBound(arrDirs) + 1)
            I = UBound(arrDirs)
            arrDirs(I) = iLookIn & MyInfo & "\"
        End If
    Wend
End Sub

HTH
dragontooth

0
 
Tommy KinardCommented:
Opps
Text1.text contains the directory to look in
Text2.text contains the replacement file
Text3.text contains the rplacement file path

dragontooth

0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 3
  • 2
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now