Category: IT Professional Development

This comes up quite a bit in MS Access applications. It’s not something many Access developers use that often so as a refresher and for those newer to Access VBA, the below sample code shows how to loop through a Windows folder and files, open each file of a certain file type, search for a particular pattern in the lines of the file and then do something if a pattern is found. Drop the Sub into a VBA Module and give it a try.

Sub Test()

'set a reference under Tools/References 
'to Windows Script Host for FileSystemObject
'and Folder/File objects

Dim fso As FileSystemObject
Dim fld As Folder
Dim sTargetFolder As String
Dim sFilePath As String
Dim tsTextFile As TextStream
Dim sTextFileLine As String
Dim sSql As String

On Error GoTo Error_Handler

'If there may be a large number of files, 
'turn on the hourglass to let the user 
'know things are progressing
DoCmd.Hourglass (True) 

Set fso = New FileSystemObject

sTargetFolder = "D:\Temp"

'Confirm Folder exists and if not, alert the user
sFolderExists = Dir(sTargetFolder, vbDirectory) 
If sFolderExists = "" Then
   MsgBox "Folder Not Found."
   Exit Sub
End If

Set fld = fso.GetFolder(sTargetFolder)

For Each File In fld.Files

'make sure of the file type incase other files are
'stored in the folder that you may not want to process
 If InStr(1, File.Type, "Text Document") > 0 Then

    If File.Size > 0 Then 'make sure the file is not empty

       sFilePath = sTargetFolder & "\" & File.Name
       Set tsTextFile = fso.OpenTextFile(sFilePath, ForReading)

       Do Until tsTextFile.AtEndOfStream
          sTextFileLine = tsTextFile.ReadLine

          'Example: find a specific attribute/pattern on a 
          'file line such as "QTY"
          If Left(sTextFileLine, 4) = "QTY " Then 
             'Example: parse the line for a related value
             'on the same line
              sQty = Mid(sTextFileLine, 5, Len(sTextFileLine))
          End If
       Loop

       tsTextFile.Close

'After the file has been read, if a match and
'value have been found,
'do something such as insert the data into a table
If sQty <> "" Then 
   sSql = "INSERT INTO tblTest (FileName, QTY) "
   sSql = sSql & " VALUES('" & File.Name & "','" & sQty & "')"
   CurrentDb.Execute (sSql)
End If

End If

End If

Next File

Error_Handler:
Select Case Err.Number
       Case 0:
            DoCmd.Hourglass (False)
            Exit Sub
       Case Else
            DoCmd.Hourglass (False)
            MsgBox CStr(Err.Number) & "-" & Err.Description
End Select

End Sub