View Single Post
  #14   Report Post  
Posted to microsoft.public.excel.misc
Angela[_2_] Angela[_2_] is offline
external usenet poster
 
Posts: 38
Default 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.