Code:
Sub testme()
Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim defaultproject As String
Dim ProjectName As String
'Key in your Project Name
defaultproject = "2005 Brookside Property - ALL"
ProjectName = InputBox("Enter Project Name", "Project Name:",
defaultproject)
'Key in your City or Town
city = "Brookside"
CityName = InputBox("Enter City or Town Name", "City or Town
Name:", city)
'change to point at the folder to check
'myPath = "c:\test"
myPath = "\\Hpoffice\my documents\Projects\HMGP\Brookside\2005
Brookside Project Application\CRS Full Reports"
myPath = InputBox("Enter Path of Folder Containing Text Files",
"Text Files Folder:", myPath)
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
myFile = Dir(myPath & "*.txt")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If
'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop
If fCtr > 0 Then
'Set wks = Workbooks.Add(1).Worksheets(1)
Set wks = Workbooks.Add(1).Worksheets(1)
' wks.Range("a1").Resize(1, 3).Value _
' = Array("Property Address", "City", "FileName")
wks.Range("a1").Resize(1, 6).Value _
= Array("Property Address", "City", "Land Value", "Imp
Value", "Tot Value", "FileName")
For fCtr = LBound(myFiles) To UBound(myFiles)
Call DoTheWork(myPath & myFiles(fCtr), wks)
Next fCtr
wks.UsedRange.Columns.AutoFit
End If
End Sub
Sub DoTheWork(myFileName As String, wks As Worksheet)
Dim myNumber As Long
Dim myLine As String
Dim FileNum As Long
Dim oRow As Long
Dim FoundAddr As Boolean
Dim FoundCity As Boolean
Dim FoundLandValue As Boolean
Dim FoundImpValue As Boolean
Dim FoundTotValue As Boolean
Dim StrAddr As String
Dim StrCity As String
Dim StrLandValue As String
Dim StrImpValue As String
Dim StrTotValue As String
'StrAddr = LCase(" Property Address:")
StrAddr = LCase("Property Address:")
StrCity = LCase("| TAX DISTRICT:") 'City
StrLandValue = LCase("Land Value:") 'Land Value
StrImpValue = LCase("Improvement Value:") 'Structures Value
StrTotValue = LCase("Total Value:") 'Land Value + Structures Value
With wks
oRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
FoundAddr = False
FoundCity = False
FoundLandValue = False
FoundImpValue = False
FoundTotValue = False
FileNum = FreeFile
Close FileNum
Open myFileName For Input As FileNum
' wks.Cells(oRow, "C").Value = myFileName
wks.Cells(oRow, "F").Value = myFileName
Do While Not EOF(FileNum)
Line Input #FileNum, myLine
'If LCase(Left(myLine, Len(Str1))) = Str1 Then
If LCase(Left(Trim(myLine), Len(StrAddr))) = StrAddr Then
wks.Cells(oRow, "A").Value = Trim(Mid(myLine, Len(StrAddr) +
1))
FoundAddr = True
ElseIf LCase(Left(Trim(myLine), Len(StrCity))) = StrCity Then
wks.Cells(oRow, "B").Value = Trim(Mid(myLine, Len(StrCity) +
1))
FoundCity = True
Exit Do 'no need to contine reading the file
ElseIf LCase(Left(Trim(myLine), Len(StrLandValue))) =
StrLandValue Then
wks.Cells(oRow, "C").Value = Trim(Mid(myLine,
Len(StrLandValue) + 1))
FoundLandValue = True
Exit Do 'no need to contine reading the file
ElseIf LCase(Left(Trim(myLine), Len(StrImpValue))) =
StrImpValue Then
wks.Cells(oRow, "D").Value = Trim(Mid(myLine,
Len(StrImpValue) + 1))
FoundImpValue = True
Exit Do 'no need to contine reading the file
ElseIf LCase(Left(Trim(myLine), Len(StrTotValue))) =
StrTotValue Then
wks.Cells(oRow, "E").Value = Trim(Mid(myLine,
Len(StrTotValue) + 1))
FoundTotValue = True
Exit Do 'no need to contine reading the file
End If
Loop
If FoundAddr = False Then
wks.Cells(oRow, "A").Value = "**Error**"
End If
If FoundCity = False Then
wks.Cells(oRow, "B").Value = "**Error**"
End If
If FoundLandValue = False Then
wks.Cells(oRow, "C").Value = "**Error**"
End If
If FoundImpValue = False Then
wks.Cells(oRow, "D").Value = "**Error**"
End If
If FoundTotValue = False Then
wks.Cells(oRow, "E").Value = "**Error**"
End If
Close FileNum
End Sub
Results:
Bookmarks