Posted to microsoft.public.excel.misc
|
|
COMPILE LOG FROM INFO WITHIN MULTIPLE TEXT FILES
On Mar 9, 6:06*am, Joel wrote:
I change the line below from 4001 to 4071. *The new options will remeber the
last folder selected and also contain a box so you can paste in an address
rather than always have to select a path. *See if you like this better. *If
not I will do more research tomorrow.
Set objFolder = objShell.BrowseForFolder(&H0&, "Select Folder ", &H4071&,
&H8&)
"Angela" wrote:
On Mar 9, 12:03 am, Joel wrote:
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
...
read more »- Hide quoted text -
- Show quoted text -
Thx Jeol for your patience and help.
I have uploaded the file at http://www.savefile.com/files/2032417
This is what I'm looking for.
Thx once again. I'm grateful.
|