Help with nested Do loop and Dir

[sbinning1017]

Hi, I am writing a small app to search a certain folder for other folders, then filter through each file and place it in a table. I have this working until I need to get the next folder in the directory. It will search through the directory, skip past the "." and ".." folders, identify the first folder in the directory, find the files in there and put them in the table. But when there are no more files in that folder, I would like it to go get the next folder and continue on in the same way. That's where I'm having trouble. I get "Invalid procedure call or argument" when it calls GetNextFolder.

This seems like it should be simple. What am I missing?

Thank you.



Shauna

Function GetFiles3()
Dim rs As Recordset
Dim sFile As String, dDate As Date
Dim sFolder As String
Dim sPath As String
Dim sPayPd As String
Dim sEmpID As String
Dim sDocType As String
Dim sFromPath As String
Dim sToPath As String

'sPath = "\\ACFILE1\Vol1\ProdData\Pay_Images\-01000\"
sPath = "\\ACFILE1\Vol1\ProdData\Pay_Images\"

sDocType = "HSA" 'update depending on doc type search

sFolder = Dir(sPath, vbDirectory)

Do
If sFolder = "" Then GoTo ExitHere
If sFolder = "." Or sFolder = ".." Then GoTo GetNextFolder


'Empty table

CurrentDb.Execute "DELETE * FROM tbl" & sDocType & "Documents", dbFailOnError


'Open recordset
Set rs = CurrentDb.OpenRecordset("tbl" & sDocType & "Documents", dbOpenDynaset)

'First filename
sPath = sPath & sFolder & "\"
sFile = Dir(sPath & "*" & sDocType & "*")

'Loop through rest of files
Do
'Make sure there is a filename
If sFile = "" Then GoTo ExitHere
dDate = FileDateTime(sPath & sFile)
rs.AddNew

'Populate table
rs!FileName = Left(sFile, Len(sFile) - 4)
rs!FileDate = dDate
rs!sEmpID = Left(sFile, InStr(1, sFile, ".") - 1)
rs!sPayPd = Left(Right(Trim(sFile), Len(Trim(sFile)) - InStr(1, sFile, "_")), Len(Right(Trim(sFile), Len(Trim(sFile)) - InStr(1, sFile, "_"))) - 4)
rs!sDocType = sDocType
rs.Update

'Next filename
sFile = Dir()
Loop

GetNextFolder:
sFolder = Dir()
Loop

ExitHere:
Set rs = Nothing
MsgBox ("Directory list is complete.")
End Function

[June7]

Review http://www.allenbrowne.com/ser-59.html

[sbinning1017]

Review http://www.allenbrowne.com/ser-59.html

Thank you. I followed those instructions and it does put the file names and locations into a table, but I would have no idea how to modify that code to pull what I need, such as additional fields in the table (see my original code). For example, here is a file name
166.HSA_201106.pdf
I want a field in the table that is the digits before the 1st period and another for the digits after the underscore. Where would I add this functionality in this new code?

[June7]

Don't actually have to modify Allen's code. Once the table is populated, could have another procedure do whatever manipulation you want with the values.

However, if you want to modify Allen's version that writes records to table, I guess would mean changing the INSERT INTO statement to accommodate your table structure, like:

strSQL = "INSERT INTO tbl " _
& " (FileName, FileDate, sEmpID, sPayPd, sDocType) " _
& " SELECT """ & Left(strTemp, Len(1, strTemp, ".") - 1) & """" _
& ", #" & FileDateTime(strFolder & strTemp) & "#"
& ", """ & Mid(strTemp, InStr(strTemp, ".") + 1, InStr(Mid(strTemp, InStr(strTemp, ".")+1), "_") - 1) & """" _
& ", """ & Mid(strTemp, InStr(strTemp, "_") + 1, 6) & """" _
& ", """ & Mid(strTemp, InStrRev(strTemp, ".") + 1 & """;"


Will the date part always have 6 characters?

I've never tested this procedure. Not sure what strTemp holds.

[sbinning1017]

Don't actually have to modify Allen's code. Once the table is populated, could have another procedure do whatever manipulation you want with the values.

However, if you want to modify Allen's version that writes records to table, I guess would mean changing the INSERT INTO statement to accommodate your table structure, like:

strSQL = "INSERT INTO tbl " _
& " (FileName, FileDate, sEmpID, sPayPd, sDocType) " _
& " SELECT """ & Left(strTemp, Len(1, strTemp, ".") - 1) & """" _
& ", #" & FileDateTime(strFolder & strTemp) & "#"
& ", """ & Mid(strTemp, InStr(strTemp, ".") + 1, InStr(Mid(strTemp, InStr(strTemp, ".")+1), "_") - 1) & """" _
& ", """ & Mid(strTemp, InStr(strTemp, "_") + 1, 6) & """" _
& ", """ & Mid(strTemp, InStrRev(strTemp, ".") + 1 & """;"


Will the date part always have 6 characters?

I've never tested this procedure. Not sure what strTemp holds.

Thank you June!

[sbinning1017]

I got my code to work using Dir() if anyone is interested.

Function GetFiles() 'WorkingDim rs As Recordset
Dim sFile As String, dDate As Date
Dim sFolder As String
Dim sLastFolder As String
Dim sPath As String
Dim sPayPd As String
Dim sEmpID As String
Dim sDocType As String
Dim sFromPath As String
Dim sToPath As String


sPath = "\\ACFILE1\Vol1\ProdData\Pay_Images\"


sDocType = "HSA" 'update depending on doc type search




sFolder = Dir(sPath, vbDirectory)


Do While True
    
    If sFolder <> "." And sFolder <> ".." Then
    
        'Empty table
        CurrentDb.Execute "DELETE * FROM tbl" & sDocType & "Documents", dbFailOnError
        
        'Open recordset
        Set rs = CurrentDb.OpenRecordset("tbl" & sDocType & "Documents", dbOpenDynaset)
        
        'First filename
        'sPath = sPath & sFolder & "\"
        sFile = Dir(sPath & sFolder & "\" & "*" & sDocType & "*")
        
        'Loop through rest of files
        Do While sFile <> ""
            
            dDate = FileDateTime(sPath & sFolder & "\" & sFile)
            rs.AddNew
            
            'Populate table
            rs!FileName = Left(sFile, Len(sFile) - 4)
            rs!FileDate = dDate
            rs!sEmpID = Left(sFile, InStr(1, sFile, ".") - 1)
            rs!sPayPd = Left(Right(Trim(sFile), Len(Trim(sFile)) - InStr(1, sFile, "_")), Len(Right(Trim(sFile), Len(Trim(sFile)) - InStr(1, sFile, "_"))) - 4)
            rs!sDocType = sDocType
            rs.Update
            
            'Next filename
            sFile = Dir()
        Loop
    
    End If
    
    sLastFolder = sFolder
    sFolder = Dir(sPath, vbDirectory)
    Do Until sFolder > sLastFolder
        sFolder = Dir()
    Loop


Loop


ExitHere:
Set rs = Nothing
MsgBox ("Directory list is complete.")
End Function

[sbinning1017]

One little tweak at the end to handle when there are no more folders to search through. I also excluded a folder I did not want to look in.

Function GetFiles() 'WorkingDim rs As Recordset
Dim sFile As String, dDate As Date
Dim sFolder As String
Dim sLastFolder As String
Dim sPath As String
Dim sPayPd As String
Dim sEmpID As String
Dim sDocType As String
Dim sFromPath As String
Dim sToPath As String


sPath = "\\ACFILE1\Vol1\ProdData\Pay_Images\"


sDocType = "HSA" 'update depending on doc type search




sFolder = Dir(sPath, vbDirectory)


Do While True
    
    If sFolder <> "." And sFolder <> ".." And sFolder <> "Archive_AsOf12142011" And sFolder <> "" Then
        
        'Open recordset
        Set rs = CurrentDb.OpenRecordset("tbl" & sDocType & "Documents", dbOpenDynaset)
        
        'First filename
        'sPath = sPath & sFolder & "\"
        sFile = Dir(sPath & sFolder & "\" & "*" & sDocType & "*")
        
        'Loop through rest of files
        Do While sFile <> ""
            
            dDate = FileDateTime(sPath & sFolder & "\" & sFile)
            rs.AddNew
            
            'Populate table
            rs!FileName = Left(sFile, Len(sFile) - 4)
            rs!FileDate = dDate
            rs!sEmpID = Left(sFile, InStr(1, sFile, ".") - 1)
            rs!sPayPd = Left(Right(Trim(sFile), Len(Trim(sFile)) - InStr(1, sFile, "_")), Len(Right(Trim(sFile), Len(Trim(sFile)) - InStr(1, sFile, "_"))) - 4)
            rs!sDocType = sDocType
            rs.Update
            
           ' sFromPath = "\\ACFILE1\Vol1\ProdData\Pay_Images\-01000\" & sFile
           ' sToPath = "\\ACFILE1\Vol1\Group\IT\Projects\PayImages\Other\" & sFile
            
            'FileCopy sFromPath, sToPath
            
            'Next filename
            sFile = Dir()
        Loop
    
    End If
    
    sLastFolder = sFolder
    sFolder = Dir(sPath, vbDirectory)
    
    Do Until sFolder > sLastFolder
        If sFolder = "" Then GoTo ExitHere
        sFolder = Dir()
    Loop


Loop


ExitHere:
Set rs = Nothing
MsgBox ("Directory list is complete.")
End Function