Option Explicit
Public Sub ProcessTextFile()
Dim objFSO As FileSystemObject
Dim objTxt As TextStream
Dim varData As Variant
Dim i As Long, lCnt As Long, lRow As Long
Dim strFileName As String, strData As String
'\\ Choose File
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Select Text File to process!"
.Filters.Add "Text Files", "*.txt"
.Show
strFileName = .SelectedItems(1)
End With
'\\ Read data in array
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTxt = objFSO.OpenTextFile(strFileName, ForReading)
varData = Split(objTxt.ReadAll, vbCrLf)
objTxt.Close
'\\ Process Array
For i = LBound(varData) To UBound(varData)
If LCase(Trim(varData(i))) Like "*[0-9]* of [0-9]* documents*" Then
lCnt = 1
lRow = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End If
Select Case lCnt
Case 6 '\\Person Name
'\\Check number of words in the line and take action accordingly
If UBound(Split(Application.Trim(varData(i)), " ")) = 1 Then
Cells(lRow, 1).Value = Split(Application.Trim(varData(i)), " ")(0)
Cells(lRow, 2).Value = Split(Application.Trim(varData(i)), " ")(1)
Else
Cells(lRow, 1).Value = Split(Application.Trim(varData(i)), " ")(1)
Cells(lRow, 2).Value = Split(Application.Trim(varData(i)), " ")(2)
End If
Case 13 '\\Company
Cells(lRow, 3).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
Case 14 '\\address
Cells(lRow, 4).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
Case 15 '\\telephone
Cells(lRow, 5).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
Case 16 '\\email
Cells(lRow, 6).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
Case 19 '\\Job title and date updated on same line
Cells(lRow, 7).Value = Trim(Mid(varData(i), 1, 40))
Cells(lRow, 8).Value = CDate(Trim(Mid(varData(i), 41, 10)))
Case Else
End Select
lCnt = lCnt + 1
Next i
End Sub