VBA to check files on network server - Any way to optimise?

sramsay

Board Regular
Joined
Feb 19, 2015
Messages
96
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



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
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Hi,

I would use VBScript instead.

Don't panic, you can do that from VBA. In fact I just pasted the some VBScript into EXCEL and it worked without change.

Here are three examples to get you started.

Code:
Sub FileCount()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Set filesys = CreateObject("Scripting.FileSystemObject")
    
    
    Set DataFolder = filesys.GetFolder(Environ("Temp"))
    Set DataFiles = DataFolder.Files
    ws.Cells(1, "A").Value = DataFiles.Count

    Set DataFolder = filesys.GetFolder("C:\")
    Set DataFiles = DataFolder.Files
    ws.Cells(2, "A").Value = DataFiles.Count
    
    Set DataFolder = filesys.GetFolder("C:\Test")
    Set DataFiles = DataFolder.Files
    ws.Cells(3, "A").Value = DataFiles.Count

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,048
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top