Sorry... it's been a while.
I keep getting asked to do actual WORK!!!
I'm still working on it.
There are some oddities in that there are
Event Id's and logon types:
Event IDs
528 logon
540 logon
538 Logoff
551 User initiated logoff:
513 Windows shutdown
6009 Microsoft (R) Windows (R) 5.01. 2600 Service Pack 2 Multiprocessor Free
Logon Type 2 – Interactive
Logon Type 3 – Network
Logon Type 4 – Batch
Logon Type 5 – Service
Logon Type 7 – Unlock
Logon Type 8 – NetworkCleartext
Logon Type 9 – NewCredentials
Logon Type 10 – RemoteInteractive
Logon Type 11 – CachedInteractive
I haven't actually SUMMARIZED them, but here's what I have
(you'll have to have a sheet named "Log-Data")
I figured, even if i get it all for ME, then it might not work
for YOU, so maybe it would be best if you have something to work
with yourself... why should *I* have all the fun!!!
Paul
'---------------------------------------------
Option Explicit
Sub Get_WMI_Data()
Dim stat
' stat = WMI_Data("ALL") 'Obtains all data available
stat = WMI_Data(Now) 'Extracts events for TODAY
End Sub
Function WMI_Data(Optional DateFlag)
Dim colitems
Dim objitem
Dim cComputerData, oItem, sIPaddress
Dim objWMIService
Dim cLogFiles, oLog, sLogName, sWQL, sLog, LogData, Dat
Dim ShtName, nRow, nCol, lastCol, cInx
Dim sArray, msgStr, sLogTyp
Dim tStr, I, DateStr
'------------------------------------------------------------------------------------
ShtName = "Log-Data"
'------------------------------------------------------------------------------------
If (IsDate(DateFlag)) Then
DateStr = Format(DateFlag, "yyyymmdd")
Else
DateStr = "ALL"
End If
On Error Resume Next
ThisWorkbook.Sheets(ShtName).Select
If (UCase(ActiveSheet.Name) <> UCase(ShtName)) Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = ShtName
End If
ActiveSheet.ShowAllData
'------------------------------------------------------------------------------------
' Get current IP Address
'------------------------------------------------------------------------------------
sIPaddress = "127.0.0.1"
Set objWMIService = GetObject("WinMgmts:{(Security)}!//" & sIPaddress &
"/root/cimv2")
Set cComputerData = objWMIService.ExecQuery("SELECT Name FROM
Win32_ComputerSystem")
For Each oItem In cComputerData
sIPaddress = oItem.Name
Next
Set cComputerData = Nothing
'------------------------------------------------------------------------------------
' (Needed to retrieve data for current IP)
Set objWMIService = GetObject("WinMgmts:{(Security)}!//" & sIPaddress &
"/root/cimv2")
'------------------------------------------------------------------------------------
nRow = 1
Application.ScreenUpdating = False
ThisWorkbook.Sheets(ShtName).Range("A2:EW65000").ClearContents
ThisWorkbook.Sheets(ShtName).Cells(nRow, 1) = "Computer Name"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 2) = "Time Generated"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 3) = "Record Number"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 4) = "LogFile"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 5) = "User"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 6) = "Category"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 7) = "Category String"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 8) = "Event Type"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 9) = "Event Code"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 10) = "Event Identifier"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 11) = "Source Name"
ThisWorkbook.Sheets(ShtName).Cells(nRow, 12) = "Message"
'------------------------------------------------------------------------------------
sWQL = "SELECT * FROM Win32_NTLogEvent" '20091216
sWQL = "SELECT * FROM Win32_NTLogEvent WHERE (Logfile = 'Security' or
Logfile = 'System')" ' and user like 'US\\%'"
sWQL = "SELECT * FROM Win32_NTLogEvent"
Set LogData = objWMIService.ExecQuery(sWQL)
For Each Dat In LogData
msgStr = Replace(Replace(Replace(Replace(Dat.Message, vbCrLf, "|"),
Chr(9), ""), " |", "|"), ":|", ":")
sArray = Split(msgStr, "|")
If (UBound(sArray) >= 7) Then
If (UCase(Left(sArray(7), 11)) = UCase("Logon Type:")) Then
sLogTyp = sArray(7)
Else
sLogTyp = ""
End If
Else
sLogTyp = ""
End If
If UBound(Dat.insertionstrings) >= 3 Then
tStr = Dat.insertionstrings(3)
Else
tStr = ""
End If
' tStr = Dat.insertionstrings(0)
' For I = 1 To UBound(Dat.insertionstrings)
' tStr = tStr & "|" & Dat.insertionstrings(I)
' Next I
' If (IsNumeric(tStr)) Then
If ((DateStr = "ALL") _
Or (Left(Dat.timegenerated, 8) = DateStr)) Then
' If ((tStr <> "3" And tStr <> "4")) Then
nRow = nRow + 1
If (nRow Mod 100 = 0) Then Application.StatusBar = Dat.LogFile
& ": " & nRow
ThisWorkbook.Sheets(ShtName).Cells(nRow, 1) = Dat.computername
ThisWorkbook.Sheets(ShtName).Cells(nRow, 2) =
GetDate(Dat.timegenerated) & " " & GetTime(Dat.timegenerated)
ThisWorkbook.Sheets(ShtName).Cells(nRow, 3) = Dat.timegenerated
ThisWorkbook.Sheets(ShtName).Cells(nRow, 4) = Dat.LogFile
ThisWorkbook.Sheets(ShtName).Cells(nRow, 5) = Dat.user
ThisWorkbook.Sheets(ShtName).Cells(nRow, 6) = Dat.Category
ThisWorkbook.Sheets(ShtName).Cells(nRow, 7) = Dat.CategoryString
ThisWorkbook.Sheets(ShtName).Cells(nRow, 8) = Dat.eventtype
ThisWorkbook.Sheets(ShtName).Cells(nRow, 9) = Dat.EventCode
ThisWorkbook.Sheets(ShtName).Cells(nRow, 10) = sLogTyp
'Dat.EventIdentifier
ThisWorkbook.Sheets(ShtName).Cells(nRow, 11) = Dat.SourceName
ThisWorkbook.Sheets(ShtName).Cells(nRow, 12) = tStr
ThisWorkbook.Sheets(ShtName).Cells(nRow, 13) = msgStr
' End If
End If
Next Dat
'------------------------------------------------------------------------------------
Application.ScreenUpdating = True
Range("B:B").NumberFormat = "[$-409]m/d/yy h:mm:ss AM/PM;@"
' lastCol = ActiveCell.SpecialCells(xlLastCell).Column
' cInx = 0
' For nCol = 12 To lastCol
' cInx = cInx + 1
' ThisWorkbook.Sheets(ShtName).Cells(1, nCol) = "Message " & cInx
' Next nCol
Application.StatusBar = "Done"
'MsgBox "done"
Application.StatusBar = False
End Function
Function GetTime(sWmiDate)
'Pass in a WMI date like "20091221114144.000000-300"
'Returns in military hour:min:sec format, with hours from 0 to 23.
GetTime = Mid(sWmiDate, 9, 2) & ":" & Mid(sWmiDate, 11, 2) & ":" &
Mid(sWmiDate, 13, 2)
GetTime = TimeValue(GetTime) 'RecordSet needs a VB Date value.
End Function
Function GetDate(sWmiDate)
'Pass in a WMI date like "220091221114144.000000-300"
'Returns MM/DD/YYYY
GetDate = Mid(sWmiDate, 5, 2) & "/" & Mid(sWmiDate, 7, 2) & "/" &
Mid(sWmiDate, 3, 2)
GetDate = DateValue(GetDate) 'RecordSet needs a VB Date value.
End Function
________________________________
From: SumesH P S <sumesh.subbay...@gmail.com>
To: excel-macros@googlegroups.com
Sent: Sat, December 5, 2009 3:29:11 AM
Subject: Re: $$Excel-Macros$$ Time Tracker
Yes Paul,
what you mentioned is correct I have to pull that information
Thanks Sumesh
On Wed, Dec 2, 2009 at 11:18 AM, SumesH P S <sumesh.subbay...@gmail.com> wrote:
Hi All,
>
>
>Could you please help me to write a macro for saving the date and time in a
>spread sheet when the user lock the system, when the user open it also has to
>be captured.
>
>
>Many thanks for your help
>
>
>Kind regards
>Sumesh--
>----------------------------------------------------------------------------------
>Some important links for excel users:
>1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
>http://www.excelitems.com
>2. Excel tutorials at http://www.excel-macros.blogspot.com
>3. Learn VBA Macros at http://www.vbamacros.blogspot.com
>4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>
>
>To post to this group, send email to excel-macros@googlegroups.com
>If you find any spam message in the group, please send an email to:
>Ayush Jain @ jainayus...@gmail.com or
>Ashish Jain @ 26may.1...@gmail.com
><><><><><><><><><><><><><><><><><><><><><><>
>HELP US GROW !!
>
>We reach over 6,500 subscribers worldwide and receive many nice notes about
>the learning and support from the group. Our goal is to have 10,000
>subscribers by the end of 2009. Let friends and co-workers know they can
>subscribe to group at http://groups.google.com/group/excel-macros/subscribe
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,500 subscribers worldwide and receive many nice notes about the
learning and support from the group. Our goal is to have 10,000 subscribers by
the end of 2009. Let friends and co-workers know they can subscribe to group at
http://groups.google.com/group/excel-macros/subscribe
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,500 subscribers worldwide and receive many nice notes about the
learning and support from the group. Our goal is to have 10,000 subscribers by
the end of 2009. Let friends and co-workers know they can subscribe to group at
http://groups.google.com/group/excel-macros/subscribe
