View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.misc
joel joel is offline
external usenet poster
 
Posts: 9,101
Default COMPILE LOG FROM INFO WITHIN MULTIPLE TEXT FILES

I forgot the filename

Sub GetLogs()
Dim objShell As Object, objFolder As Object
Dim ID As String
Dim Num1 As String
Dim Num2 As String
Dim VG As String


Const ForReading = 1, ForWriting = -2, ForAppending = 3
Const Start = "Start:"

TABCh = Chr(9)

StartLen = Len(Start)

Set objShell = CreateObject("Shell.Application")
Set fs = CreateObject("Scripting.FileSystemObject")


On Error Resume Next
Set objFolder = objShell.BrowseForFolder(&H0&, "Select Folder ", &H4001&)
On Error GoTo 0

If objFolder Is Nothing Then
MsgBox ("Cannot open directory -xit Macro")
Exit Sub
End If

Set oFolderItem = objFolder.Items.Item
Folder = oFolderItem.Path

If Range("A1") = "" Then

'format column E
Columns("A").NumberFormat = "#."
Columns("G").NumberFormat = "DD-MMM-YYYY"
Range("A1") = "S#"
Range("B1") = "File#"
Range("C1") = "Base#"
Range("D1") = "Start"
Range("E1") = "End"
Range("F1") = "VG#"
Range("G1") = "Date"
Range("H1") = "Filename"
End If

LastRow = Range("A" & Rows.Count).End(xlUp).Row
RowCount = LastRow + 1

FName = Dir(Folder & "\" & "*.txt")
Do While FName < ""
Set fin = fs.OpenTextFile(Folder & "\" & FName, _
ForReading, TristateFalse)

FileErr = False
LineNumber = 0
Do While fin.AtEndOfStream < True
ReadData = fin.readline
LineNumber = LineNumber + 1

Select Case LineNumber
Case 2
If InStr(ReadData, "Start:") = 0 Then
MsgBox ("Bad Log File : " & FName)
FileErr = True
Exit Do
Else
ReadData = Mid(ReadData, InStr(ReadData, "Start") +
StartLen)
StartDate = Left(ReadData, InStr(ReadData, "End:") - 1)
StartDate = Trim(StartDate)
StartDay = Left(StartDate, 2)
StartMonth = Mid(StartDate, 4, 2)
StartYear = Mid(StartDate, 7, 4)
StartDate = DateSerial(StartYear, StartMonth, StartDay)


End If

Case 3
If InStr(ReadData, "Order:") = 0 Then
MsgBox ("Bad Log File : " & FName)
FileErr = True
Exit Do
Else
ID = Left(ReadData, 15)
ID = Mid(ID, 7)
ID = "V" & Left(ID, 4) & Mid(ID, 7)

'remove everything up to and including the 2nd Pack
ReadData = Mid(ReadData, InStr(ReadData, "Pack") + 4)
ReadData = Mid(ReadData, InStr(ReadData, "Pack") + 4)
ReadData = Trim(Replace(ReadData, TABCh, ""))
Num1 = Left(ReadData, 10) & "00"

'read past the word "TO"
ReadData = Trim(Mid(ReadData, InStr(ReadData, "to") + 2))
Num2 = Left(ReadData, 10) & "99"

'VG is the difference between Num1 and Num2
VG = Val(Num2) - Val(Num1) + 1
End If

Case 4
Exit Do
End Select

Loop

If FileErr = False Then
Range("A" & RowCount) = (RowCount - 1) & "."
Range("B" & RowCount) = ID
Range("D" & RowCount) = Num1
Range("E" & RowCount) = Num2
Range("F" & RowCount) = VG
Range("G" & RowCount) = StartDate
Range("H" & RowCount) = FName
RowCount = RowCount + 1

End If


fin.Close
FName = Dir()
Loop


End Sub


"Angela" wrote:

On Mar 8, 10:23 pm, Joel wrote:
Don't use ziddu. there is too much adware at this site. I made the
formatting changes. Try this new code.

Sub GetLogs()
Dim objShell As Object, objFolder As Object
Dim ID As String
Dim Num1 As String
Dim Num2 As String
Dim Vou As String

Const ForReading = 1, ForWriting = -2, ForAppending = 3
Const Start = "Start:"

TABCh = Chr(9)

StartLen = Len(Start)

Set objShell = CreateObject("Shell.Application")
Set fs = CreateObject("Scripting.FileSystemObject")

On Error Resume Next
Set objFolder = objShell.BrowseForFolder(&H0&, "Select Folder ", &H1&)
On Error GoTo 0

If objFolder Is Nothing Then
MsgBox ("Cannot open directory -xit Macro")
Exit Sub
End If

Set oFolderItem = objFolder.Items.Item
Folder = oFolderItem.Path

If Range("A1") = "" Then

'format column E
Columns("A").NumberFormat = "#."
Columns("G").NumberFormat = "DD-MMM-YYYY"
Range("A1") = "S#"
Range("B1") = "File#"
Range("C1") = "Base#"
Range("D1") = "Start"
Range("E1") = "End"
Range("F1") = "VG#"
Range("G1") = "Date"
End If

LastRow = Range("A" & Rows.Count).End(xlUp).Row
RowCount = LastRow + 1

FName = Dir(Folder & "\" & "*.txt")
Do While FName < ""
Set fin = fs.OpenTextFile(Folder & "\" & FName, _
ForReading, TristateFalse)

FileErr = False
LineNumber = 0
Do While fin.AtEndOfStream < True
ReadData = fin.readline
LineNumber = LineNumber + 1

Select Case LineNumber
Case 2
If InStr(ReadData, "Start:") = 0 Then
MsgBox ("Bad Log File : " & FName)
FileErr = True
Exit Do
Else
FileDate = Mid(ReadData, InStr(ReadData, "Start") +
StartLen)
FileDate = Left(FileDate, InStr(FileDate, "End:") - 1)
FileDate = Trim(FileDate)
FileDate = Replace(FileDate, ".", "/")
End If

Case 3
If InStr(ReadData, "Order:") = 0 Then
MsgBox ("Bad Log File : " & FName)
FileErr = True
Exit Do
Else
ID = Left(ReadData, 15)
ID = Mid(ID, 7)
ID = "V" & Left(ID, 4) & Mid(ID, 7)

'remove everything up to and including the 2nd Pack
ReadData = Mid(ReadData, InStr(ReadData, "Pack") + 4)
ReadData = Mid(ReadData, InStr(ReadData, "Pack") + 4)
ReadData = Trim(Replace(ReadData, TABCh, ""))
Num1 = Left(ReadData, 10) & "00"

'read past the word "TO"
ReadData = Trim(Mid(ReadData, InStr(ReadData, "to") + 2))
Num2 = Left(ReadData, 10) & "99"

'get the number after the colon
VG = Trim(Mid(ReadData, InStr(ReadData, ":") + 1))

End If

Case 4
Exit Do
End Select

Loop

If FileErr = False Then
Range("A" & RowCount) = (RowCount - 1) & "."
Range("B" & RowCount) = ID
Range("D" & RowCount) = Num1
Range("E" & RowCount) = Num2
Range("F" & RowCount) = VG
Range("G" & RowCount) = FileDate
RowCount = RowCount + 1

End If

fin.Close
FName = Dir()
Loop

End Sub



"Angela" wrote:
On Mar 8, 9:26 pm, Joel wrote:
I waiting for savefile to come back up so I can get the format correct for
the spreadsheet. Here is what I havew so far. I didn't remove the
duplicates. thought that should be a sepertate macro.


Sub GetLogs()
Dim objShell As Object, objFolder As Object
Dim ID As String
Dim Num1 As String
Dim Num2 As String
Dim Vou As String


Const ForReading = 1, ForWriting = -2, ForAppending = 3
Const Start = "Start:"


TABCh = Chr(9)


StartLen = Len(Start)


Set objShell = CreateObject("Shell.Application")
Set fs = CreateObject("Scripting.FileSystemObject")


On Error Resume Next
Set objFolder = objShell.BrowseForFolder(&H0&, "Select Folder ", &H1&)
On Error GoTo 0


If objFolder Is Nothing Then
MsgBox ("Cannot open directory -xit Macro")
Exit Sub
End If


Set oFolderItem = objFolder.Items.Item
Folder = oFolderItem.Path


'format column E
Columns("E").NumberFormat = "DD-MMM-YY"


LastRow = Range("A" & Rows.Count).End(xlUp).Row
RowCount = LastRow + 1


FName = Dir(Folder & "\" & "*.txt")
Do While FName < ""
Set fin = fs.OpenTextFile(Folder & "\" & FName, _
ForReading, TristateFalse)


FileErr = False
LineNumber = 0
Do While fin.AtEndOfStream < True
ReadData = fin.readline
LineNumber = LineNumber + 1


Select Case LineNumber
Case 2
If InStr(ReadData, "Start:") = 0 Then
MsgBox ("Bad Log File : " & FName)
FileErr = True
Exit Do
Else
FileDate = Mid(ReadData, InStr(ReadData, "Start") +
StartLen)
FileDate = Left(FileDate, InStr(FileDate, "End:") - 1)
FileDate = Trim(FileDate)
FileDate = Replace(FileDate, ".", "/")
End If


Case 3
If InStr(ReadData, "Order:") = 0 Then
MsgBox ("Bad Log File : " & FName)
FileErr = True
Exit Do
Else
ID = Left(ReadData, 15)
ID = Mid(ID, 7)
ID = "V" & Left(ID, 4) & Mid(ID, 7)


'remove everything up to and including the 2nd Pack
ReadData = Mid(ReadData, InStr(ReadData, "Pack") + 4)
ReadData = Mid(ReadData, InStr(ReadData, "Pack") + 4)
ReadData = Trim(Replace(ReadData, TABCh, ""))
Num1 = Left(ReadData, 10) & "00"


'read past the word "TO"
ReadData = Trim(Mid(ReadData, InStr(ReadData, "to") + 2))
Num2 = Left(ReadData, 10) & "99"


'get the number after the colon
Vou = Trim(Mid(ReadData, InStr(ReadData, ":") + 1))


End If


Case 4
Exit Do
End Select


Loop


If FileErr = False Then
Range("A" & RowCount) = ID
Range("B" & RowCount) = Num1
Range("C" & RowCount) = Num2
Range("D" & RowCount) = Vou
Range("E" & RowCount) = FileDate
RowCount = RowCount + 1


End If


fin.Close
FName = Dir()
Loop


End Sub


"Angela" wrote:
On Mar 8, 4:24 pm, Joel wrote:
Angela: Can you post you log file on savefile.com? In this case it will be
easier to write a macro that opens the log file and place the data into the
worksheet rather than take the imported data from the worksheet and convert
it to your format. the imported file got split into two columns which make
the macro harder to write. I also need to see the column spacing and any
tabs (or other special characters) that may of been changed when the file got
imported into excel.


"Angela" wrote:
Hi,


File is at link:http://www.savefile.com/files/2029405
File contains sample of below required and also sample of text file
since I was unable to align column
headers here & things were looking wierd.


I have a folder containing system generated log files around 10000.
Each has a detail file also & it is tiresome to complie all from
detail in one sheet. I think I can get same from these log files
instead.
These are five line files starting at start of file & ending at ----
end----. Sample is in sheet "Sample Text File".


I want to compile a log sheet in excel of such multiple files placed
in a folder. I should be able to browse to the folder & select all
the
files. The script will cycle through all the files and get the below
required in an excel file.
Below are the requirement:


In second line, after "LOG."date of file is mentioned [Example:
20080901].
Required format of date is dd-mmm-yyyy (01-SEP-2008)


In third line, detect fifteen len number [Example: 000001096300001]
Required is V0963001 (remove first 6 from left, add alphabet
"V"(upper
case) to the left, remove 2 zeros at 11th & 12th position and combine
remaining two from right forming V0963001


In third line, detect two ten len numbers [Example: 0004291833 to
0004292832]
Required is "000429183300" and "000429283299".
Add "00" to first number & add "99" to second number from right..


Excel log sheet format is in sheet "Log Sheet".
(Sort ascending "Start#")


A macro solution would be much appreciated.


Thx.- Hide quoted text -


- Show quoted text -


Dear Joel,


Valid


...