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