chassouna
asked on
VBA Macro: Traverse through subfolders
Hello
The following script (thanks to Jeews) modifies the Word documents in the given path to change the attached template. It fits my needs perfectly, except that it modifies only the files in the given folder and it's subfolders. I need to go through the whole directory structure, not only one "folder layer". The code should modify all of the .doc's in all subfolders, even in it's subfolders and so on...
Thank you.
Word 2003
The following script (thanks to Jeews) modifies the Word documents in the given path to change the attached template. It fits my needs perfectly, except that it modifies only the files in the given folder and it's subfolders. I need to go through the whole directory structure, not only one "folder layer". The code should modify all of the .doc's in all subfolders, even in it's subfolders and so on...
Thank you.
Word 2003
Public PcLogFileName As String
Public PcError As String
Sub CallChangeTemplates()
Dim lcCurrentDir As String
lcCurrentDir = "C:\Documents and Settings\URathnayake\My Documents\Expert Exchange\Skip write - Password protected"
PcLogFileName = lcCurrentDir + "\" + "DocumentAccessSummery.txt"
ChangeTemplates lcCurrentDir, "*.doc*"
End Sub
Sub ChangeTemplates(lcFilePath As String, strFilePattern As String)
Dim loFileSystemObject, loDirectoryList As Object
Dim lcLogString, lcChildDirectoryName, lcDirectoryPath, lcFileName, lcFileFullPath As String
' Create an object form the filesystem object
Set loFileSystemObject = CreateObject("Scripting.FileSystemObject")
' Get the list of clients. Note: Folders should be named with the patner names
Set loDirectoryList = loFileSystemObject.GetFolder(lcFilePath).SubFolders
Set loFileList = loFileSystemObject.GetFolder(lcFilePath).Files
' Traverse through the files
For Each loFile In loFileList
' Get the file name to a variable to be used below
lcFileName = loFile.Name
' Check only for excel fiels
If InStr(1, lcFileName, "doc") > 0 And Not InStr(1, lcFileName, "~$") = 1 Then
' Construct the full path of the document
lcFileFullPath = lcFilePath & "\" & lcFileName
' Check whether the file is open
If Not IsFileOpen(lcFileFullPath) Then
' Checks the file is password protected
On Error Resume Next
Set Doc = Application.Documents.Open(lcFileFullPath, , , , "**")
' File is password protected
If Err > 0 Then
Update_Log ("File: " + lcFileFullPath + " is Password protected.")
Else
Doc.AttachedTemplate = NormalTemplate
Doc.Close wdSaveChanges
End If
Else
Update_Log ("File: " + lcFileFullPath + " is in use.")
End If
End If
Next
' Traverse to each client folder to check get the available reports
For Each loDirectory In loDirectoryList
' Get the Name of the processing client
lcChildDirectoryName = loDirectory.Name
' Get the full path of the client directory
lcDirectoryPath = loDirectory.Path
' Get the list of files under the client folder to be searched for MSR reports and procees with the updating
Set loFileList = loFileSystemObject.GetFolder(lcDirectoryPath).Files
' Traverse through the files
For Each loFile In loFileList
' Get the file name to a variable to be used below
lcFileName = loFile.Name
' Check only for word fiels without the temporary files
If InStr(1, lcFileName, "doc") > 0 And Not InStr(1, lcFileName, "~$") = 1 Then
' Construct the full path of the document
lcFileFullPath = lcDirectoryPath & "\" & lcFileName
' Check whether the file is open
If Not IsFileOpen(lcFileFullPath) Then
' Checks the file is password protected
On Error Resume Next
Set Doc = Application.Documents.Open(lcFileFullPath, , , , "**")
' File is password protected
If Err > 0 Then
Update_Log ("File: " + lcFileFullPath + " is Password protected.")
Else
Doc.AttachedTemplate = NormalTemplate
Doc.Close wdSaveChanges
End If
Else
Update_Log ("File: " + lcFileFullPath + " is in use.")
End If
End If
Next
Next
loFileSystemObject.Delete
loDirectoryList.Delete
End Sub
Function IsFileOpen(lcFileName As String)
Dim lnFileNum As Integer, lnErrNum As Integer
On Error Resume Next ' Turn error checking off.
lnFileNum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open lcFileName For Input Lock Read As #lnFileNum
Close lnFileNum ' Close the file.
lnErrNum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case lnErrNum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error lnErrNum
End Select
End Function
Function Update_Log(lcString As String)
If Not IsEmpty(lcString) Then
lcString = FormatDateTime(Date, vbLongDate) + " : " + FormatDateTime(Time, vbLongTime) + " : " + lcString
cfilename = FreeFile()
On Error Resume Next
Open PcLogFileName For Append As cfilename
Print #cfilename, lcString
Close #cfilename
Err
End If
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Very good, now all documents in every subfolder are processed. But now the documents in the root folder stay unchanged (that files that resides just in the folder we define in line 9). I think this is a small code change (as it worked in the previous code).
Thank you!
Thank you!
I have done that change also in the previous post please check
ASKER
I'm very thankful for your assistance, Jeews. You saved me a lot of time. Thank you!
ASKER
Ups, I copied the code without the supplemented line...
I'm very thankful for your assistance, Jeews. You saved me a lot of time. Thank you!
I'm very thankful for your assistance, Jeews. You saved me a lot of time. Thank you!
You are always welcome chassouna :-)
Please let me know if you need further assistance
Open in new window