Excel - Retrieving data from .dat files

  • Thread starter Thread starter ijohanse
  • Start date Start date
I

ijohanse

I need to gather some information from a great number of .dat files into
excel. The file format is something like this:

! User ID: 564582
! Conversion tables(Account): <NONE>
! Conversion tables(Entity): <NONE>
! Operation: <NONE>
! By: <NONE>

MON2003
12
12
AIF,3001,-10000.000000000
AIF,3001,-10000.000000000
CTY,3001,-10000.000000000

The data I would like to retrieve to excel is the User ID in the
header, as well as the code in three first lines + the last line of the
file. I also need to gather some file info - filename, path, size. I
have over 500 files like this....

Any suggestions?
 
It sounds like these files are spread all over creation.

If they're actually in one folder, you could try this. It searches for .txt
files.

Option Explicit
Dim oRow As Long
Dim logWks As Worksheet
Sub ReadEachFile(myFileName As String)

Dim myInFileNum As Long
Dim lCtr As Long
Dim myStr As String
Dim myLine As String
Dim lastNonBlankLine As Long

With logWks.Cells(oRow, 1)
.Value = myFileName
.Offset(0, 1).Value = FileLen(myFileName)
End With

myInFileNum = FreeFile()
Close #myInFileNum
Open myFileName For Input As #myInFileNum
lCtr = 0
Do While Not EOF(myInFileNum)
lCtr = lCtr + 1
Line Input #myInFileNum, myLine
Select Case lCtr
Case Is = 1, 2, 3
logWks.Cells(oRow, lCtr + 2).Value = myLine
Case Else
If Trim(myLine) = "" Then
'do nothing
Else
myStr = myLine
lastNonBlankLine = lCtr
End If
End Select
Loop
Close #myInFileNum

If lastNonBlankLine > 3 Then
logWks.Cells(oRow, 6).Value = myStr
End If

End Sub
Sub RetrieveFileInfo()

Application.ScreenUpdating = False

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String

Set logWks = Workbooks.Add(1).Worksheets(1)
logWks.Range("a1").Resize(1, 6).Value _
= Array("Name", "Size", "Line1", "Line2", "Line3", "lastLine")

'change to point at the folder to check
myPath = "c:\my documents\excel\test"
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
MsgBox "No files Found."
Else
oRow = 2 'headers in 1?
For fCtr = LBound(myFiles) To UBound(myFiles)
Call ReadEachFile(myPath & myFiles(fCtr))
oRow = oRow + 1
Next fCtr
End If

With logWks
.Range("c:c").Replace what:="! user id: ", replacement:="", _
lookat:=xlPart, MatchCase:=False, searchorder:=xlByRows
.Range("d:d").Replace what:="! Conversion tables(Account): ", _
replacement:="", lookat:=xlPart, MatchCase:=False, _
searchorder:=xlByRows
.Range("e:e").Replace what:="! Conversion tables(Entity): ", _
replacement:="", lookat:=xlPart, MatchCase:=False, _
searchorder:=xlByRows
.UsedRange.Columns.AutoFit
End With

End Sub

If you really have them over multiple folders, you can run this multiple times
and copy|paste into a single worksheet later.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
change that *.txt to *.dat

I didn't notice the extension (in either the header or the body!!!).


Dave Peterson wrote:
 
Back
Top