The code below will loop through a list and check network folders and return the number of documents that is contained within those folders.
Depending on how quick the network server is running on a particular day this can take sometime to complete.
I’m just wondering if anyone can see if any changes could be made to the code to speed it up any.
- If not, how would I add a progress bar to show how far through the macro has progressed (Eliminating anyone thinking the document has crashed)?
Thanks
Depending on how quick the network server is running on a particular day this can take sometime to complete.
I’m just wondering if anyone can see if any changes could be made to the code to speed it up any.
- If not, how would I add a progress bar to show how far through the macro has progressed (Eliminating anyone thinking the document has crashed)?
Thanks
Code:
Sub checkFolder()
Dim lstrow As Long
Dim I As Long
Dim strFileName As String
Dim siteName As String
Dim strFolderPath As String
Dim strFolderPathTemp As String
Dim subsitename As String
Dim utilityType As String
Dim FileCount As Integer
Dim lftParen As Integer
Dim ritParen As Integer
Dim subSite As Boolean
Application.ScreenUpdating = False
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.count, "G").End(xlUp).Row
For I = 11 To lstrow
On Error Resume Next
subSite = False
strFolderPath = getFolderLocation(range("G" & I))
strFolderPathTemp = strFolderPath & "\Recharges to be sent\"
strFileName = Dir(strFolderPathTemp & "*")
Do While strFileName <> ""
FileCount = FileCount + 1
strFileName = Dir()
Loop
range("BI" & I).Value = FileCount
FileCount = 0
strFolderPathTemp = strFolderPath & "\Meter Reads\"
strFileName = Dir(strFolderPathTemp & "*")
Do While strFileName <> ""
FileCount = FileCount + 1
strFileName = Dir()
Loop
range("BK" & I).Value = FileCount
FileCount = 0
strFolderPathTemp = strFolderPath & "\Changes\"
strFileName = Dir(strFolderPathTemp & "*")
Do While strFileName <> ""
FileCount = FileCount + 1
strFileName = Dir()
Loop
range("BM" & I).Value = FileCount
FileCount = 0
Next I
On Error GoTo 0
Set fs = Nothing
Application.ScreenUpdating = True
End Sub