I have written the following code to import data from a Concurrent licence file on a server. The next part I would like to then go through the entries and find the OUT: entry and then look down the sheet and find the corresponding IN: so that I can see how long the person had the licence out for. I just don't know how to do it. I think if I use an Array it will get ugly as some of these logs are months long:
Option Explicit
Sub ImportAppData(importTable, importFile)
Dim WB2 As Workbook
Dim WS2 As Worksheet
Dim lRow, lCol, x As Long
Dim preDate, postDate As Date
Dim strAPPStats() As String
Dim strTimeStamp
lCol = 3
WB1.Sheets.Add
Set WS2 = WB1.ActiveSheet
WS2.Name = "App_Logs_Import"
Set WB2 = Workbooks.Open(importFile)
WB2.Sheets(1).Cells.Copy WS2.Cells
WB2.Close False
lRow = 1
lCol = 1
Do While WS2.Cells(lRow, lCol) <> ""
If InStr(WS2.Cells(lRow, lCol), "IN:") = 0 _
And InStr(WS2.Cells(lRow, lCol), "OUT:") = 0 _
And InStr(WS2.Cells(lRow, lCol), "TIMESTAMP") = 0 _
And InStr(WS2.Cells(lRow, lCol), "UNSUPPORTED:") = 0 _
And InStr(WS2.Cells(lRow, lCol), "DENIED:") = 0 Then
WS2.Cells(lRow, lCol).EntireRow.Delete
lRow = lRow - 1
Else
If Left(WS2.Cells(lRow, lCol), 1) = " " Then
WS2.Cells(lRow, lCol) = LTrim(WS2.Cells(lRow, lCol))
End If
End If
lRow = lRow 1
Loop
lRow = 1
lCol = 1
Do While strTimeStamp = 0
If InStr(WS2.Cells(lRow, lCol), "TIMESTAMP") <> 0 Then
strTimeStamp = us2ukDate(WS2.Cells(lRow, lCol))
strTimeStamp = Format$(strTimeStamp, "dd/mmm/yyyy")
WS2.Cells(lRow, lCol).EntireRow.Delete
lRow = lRow - 1
Else
WS2.Cells(lRow, lCol).EntireRow.Delete
lRow = lRow - 1
End If
lRow = lRow 1
Loop
Do While WS2.Cells(lRow, lCol) <> ""
If InStr(WS2.Cells(lRow, lCol), "TIMESTAMP") <> 0 Then
strTimeStamp = us2ukDate(WS2.Cells(lRow, lCol))
strTimeStamp = Format(strTimeStamp, "dd/mmm/yyyy")
WS2.Cells(lRow, lCol).EntireRow.Delete
lRow = lRow - 1
ElseIf InStr(WS2.Cells(lRow, lCol), "UNSUPPORTED:") <> 0 Then
strAPPStats = Split(WS2.Cells(lRow, lCol), " ")
For x = LBound(strAPPStats) To UBound(strAPPStats)
If x = 0 Then
WS2.Cells(lRow, lCol) = Format$(strTimeStamp & " " & strAPPStats(x), "dd/mmm/yyyy HH:MM")
lCol = lCol 1
ElseIf x = 2 Or x = 3 Or x = 8 Then
WS2.Cells(lRow, lCol) = strAPPStats(x)
lCol = lCol 1
End If
Next
ElseIf InStr(WS2.Cells(lRow, lCol), "OUT:") <> 0 Then
strAPPStats = Split(WS2.Cells(lRow, lCol), " ")
For x = LBound(strAPPStats) To UBound(strAPPStats)
If x = 0 Then
WS2.Cells(lRow, lCol) = Format$(strTimeStamp & " " & strAPPStats(x), "dd/mmm/yyyy HH:MM")
lCol = lCol 1
ElseIf x = 2 Or x = 3 Or x = 4 Then
WS2.Cells(lRow, lCol) = strAPPStats(x)
lCol = lCol 1
End If
Next
ElseIf InStr(WS2.Cells(lRow, lCol), "IN:") <> 0 Then
strAPPStats = Split(WS2.Cells(lRow, lCol), " ")
For x = LBound(strAPPStats) To UBound(strAPPStats)
If x = 0 Then
WS2.Cells(lRow, lCol) = Format$(strTimeStamp & " " & strAPPStats(x), "dd/mmm/yyyy HH:MM")
lCol = lCol 1
ElseIf x = 2 Or x = 3 Or x = 4 Then
WS2.Cells(lRow, lCol) = strAPPStats(x)
lCol = lCol 1
End If
Next
ElseIf InStr(WS2.Cells(lRow, lCol), "DENIED:") <> 0 Then
strAPPStats = Split(WS2.Cells(lRow, lCol), " ")
For x = LBound(strAPPStats) To UBound(strAPPStats)
If x = 0 Then
WS2.Cells(lRow, lCol) = Format$(strTimeStamp & " " & strAPPStats(x), "dd/mmm/yyyy HH:MM")
lCol = lCol 1
ElseIf x = 2 Or x = 3 Or x = 4 Or x = 5 Then
WS2.Cells(lRow, lCol) = strAPPStats(x)
lCol = lCol 1
End If
Next
End If
lCol = 1
lRow = lRow 1
Loop
End Sub
What I want to do next is add a column and then work through the sheet looking for the first entry (OUT:) and then match it to the IN: (the same date, ignore the time) entry for the same user and then move them both to the same line.
Data I'm importing is:
4:39:18 (*****) TIMESTAMP 3/14/2022
8:24:12 (*****) OUT: "Application1" User1@Win10PC1
8:24:12 (*****) OUT: "Application2" User1@Win10PC1
8:49:23 (*****) OUT: "Application1" User2@Win10PC2
8:49:23 (*****) OUT: "Application2" User2@Win10PC2
8:59:40 (*****) OUT: "Application1" User3@Win10PC3
8:59:40 (*****) OUT: "Application3" User3@Win10PC3
13:39:22 (*****) IN: "Application1" User1@Win10PC1
13:39:22 (*****) IN: "Application2" User1@Win10PC1
13:53:43 (*****) OUT: "Application1" User1@Win10PC1
13:53:44 (*****) OUT: "Application2" User1@Win10PC1
14:41:53 (*****) OUT: "Application1" User3@Win10PC3
14:55:24 (*****) IN: "Application1" User3@Win10PC3
17:48:59 (*****) IN: "Application1" User2@Win10PC2
17:48:59 (*****) IN: "Application2" User2@Win10PC2
18:07:09 (*****) IN: "Application1" User3@Win10PC3
18:07:09 (*****) IN: "Application3" User3@Win10PC3
18:32:53 (*****) IN: "Application1" User1@Win10PC1
18:32:54 (*****) IN: "Application2" User1@Win10PC1
20:49:46 (*****) OUT: "Application1" User1@Win10PC1
20:49:47 (*****) OUT: "Application2" User1@Win10PC1
23:29:03 (*****) IN: "Application2" User1@Win10PC1
23:29:03 (*****) IN: "Application1" User1@Win10PC1
The code imports the data into the sheet like this :
-------------------------------------------------------------
| 14/Mar/2022 8:24 | OUT: | "Application1" | User1@Win10PC1 |
| 14/Mar/2022 8:24 | OUT: | "Application2" | User1@Win10PC1 |
| 14/Mar/2022 8:49 | OUT: | "Application1" | User2@Win10PC2 |
| 14/Mar/2022 8:49 | OUT: | "Application2" | User2@Win10PC2 |
-------------------------------------------------------------
and what I trying to get to is:
------------------------------------------------------------------------
| Out | In | Application | User |
------------------------------------------------------------------------
| 14/Mar/2022 8:24 | 14/Mar/2022 13:39 | Application1 | User1@Win10PC1 |
| 14/Mar/2022 8:49 | 14/Mar/2022 17:48 | Application1 | User2@Win10PC2 |
------------------------------------------------------------------------
------------------------------------------------------------------------
| Out | In | Application | User |
------------------------------------------------------------------------
| 14/Mar/2022 8:24 | 14/Mar/2022 13:39 | Application2 | User1@Win10PC1 |
| 14/Mar/2022 8:49 | 14/Mar/2022 17:48 | Application2 | User2@Win10PC2 |
------------------------------------------------------------------------
------------------------------------------------------------------------
| Out | In | Application | User |
------------------------------------------------------------------------
| 14/Mar/2022 8:59 | 14/Mar/2022 18:07 | Application3 | User3@Win10PC3 |
------------------------------------------------------------------------
TYIA
EDIT:
Now found this situation:
8:59:40 (*****) OUT: "Application1" user2@Win10PC2
8:59:40 (*****) OUT: "Application2" user2@Win10PC2
14:41:53 (*****) OUT: "Application1" user2@Win10PC2
14:55:24 (*****) IN: "Application1" user2@Win10PC2
18:07:09 (*****) IN: "Application1" user2@Win10PC2
18:07:09 (*****) IN: "Application2" user2@Win10PC2
CodePudding user response：
I've done this with similar log files before and it's usually easier to read the file directly in one pass instead of parsing it after opening in Excel.
For example (just dealing with OUT and IN to simplify and because I wasn't sure what you're doing with the other flags)
EDIT - handle multiple checkouts of the same license per user.
Sub ImportLog()
Const ForReading = 1
Dim f As Object, wsResults As Worksheet, dt As String, l As String, arr
Dim dict As Object, rw As Long, k, ts, app, usr, action, col As Collection
Set dict = CreateObject("scripting.dictionary") 'for tracking sheet row numbers
Set wsResults = ThisWorkbook.Sheets("Logs")
wsResults.UsedRange.Offset(1, 0).ClearContents 'leave the headers
rw = 1
dt = "{no date}" 'until we hit a TIMESTAMP line...
Set f = CreateObject("scripting.filesystemobject"). _
opentextfile("C:\Temp\log.txt", ForReading)
Do While Not f.AtEndOfStream
l = Trim(f.readline()) 'read a line
If Len(l) > 0 Then 'any data?
arr = Split(l, " ") 'split to array
If l Like "*TIMESTAMP*" Then
dt = GetDate(arr(UBound(arr))) 'pick up the date?
Else
ts = dt & " " & Trim(arr(0))
action = arr(2) 'OUT/IN/etc
app = Replace(arr(3), """", "")
usr = arr(4)
k = app & "~~" & usr 'user app combination
Select Case action
Case "OUT:" 'checking out: record info and row number
rw = rw 1
'collection allows for multiple "OUT" rows per key
If Not dict.exists(k) Then Set dict(k) = New Collection
dict(k).Add rw 'add row number for this check-out to the collection
With wsResults.Rows(rw)
.Cells(1).Value = ts 'add checkout info...
.Cells(3).Value = app
.Cells(4).Value = usr
End With
Case "IN:"
If dict.exists(k) Then 'is there a check-out for this app user?
Set col = dict(k)
wsResults.Cells(col(1), 2).Value = ts 'add the "IN" time
col.Remove 1 'remove the row we just closed from the collection
If col.Count = 0 Then dict.Remove k 'all rows closed for this key
Else
'no corresponding "out" record...
Debug.Print "No match: " & l
End If
End Select
End If 'TIMESTAMP?
End If
Loop
f.Close
'any licenses checked out but not checked in?
If dict.Count > 0 Then
Debug.Print "Unclosed checkouts"
For Each k In dict
Debug.Print , k
Next k
End If
End Sub
Function GetDate(txt)
Dim arr
arr = Split(Trim(txt), "/")
GetDate = arr(1) & "/" & arr(0) & "/" & arr(2) 'swap day/month
End Function
Output from your sample data: you can tidy it up with a bit of sorting/grouping
