G
Guest
Dear Experts,
I have created a script to extract the Event Logs from the system into an
excel sheet. The logs are separated into 2 worksheets (Application Log and
System Log). After this excel file being created, it will be sent out via
email to the list of recipients.
I run the script on my notebook (also developed on th same machine) it works
fine. However, when I copy all the programs into the server which running on
Windows 2000 sp4 with NET Framework 2.0 installed. The error message that I
received was as follow:
-2147467261
Attempted to read or write protected memory. This is often an indication
that other memory is corrupt.
My program code is as follow:
Imports System.Net.Mail
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Diagnostics
Imports Excel
Module Module1
Public strXLFile, strXLNewFile, strOldXLFile, strLogFile As String
Sub Main()
Dim oXL As New Excel.Application
Dim objExcel As Object
Dim objWorkbook As Object
'Dim oNewWBKs As Excel.Workbooks
Dim oNewWBK As Excel.Workbook
Dim oNewAppLogWS As New Excel.Worksheet
Dim oNewSysLogWS As New Excel.Worksheet
Dim iRow As Integer
Dim strComputerName As String
Dim strLogFile As String
Dim objOutputLog As Object
Try
Dim objFSO = CreateObject("Scripting.FileSystemObject")
'Set output log file
strLogFile = objFSO.getSpecialFolder(2).path & "\" &
"EventLogFile.txt"
objOutputLog = New StreamWriter(strLogFile, True)
objOutputLog.WriteLine(vbCrLf & Now() & " : Started")
strComputerName = GetComputerName()
strXLNewFile = objFSO.getSpecialFolder(2).path & "\" &
strComputerName & "-" & Today.ToString("ddMMMyyyy") & "-" &
Now().ToString("HHmm") & ".xls"
'strXLNewFile = "C:\Data\EventLog\" & strComputerName & "-" &
Today.ToString("ddMMMyyyy") & "-" & Now().ToString("HHmm") & ".xls"
objExcel = CreateObject("Excel.Application")
objWorkbook = objExcel.Workbooks.Add
objWorkbook.SaveAs(strXLNewFile)
objExcel.workbooks.close()
objWorkbook = Nothing
objExcel.quit()
objExcel = Nothing
'Create Header for Application Log
oNewWBK = oXL.Workbooks.Open(strXLNewFile)
oNewAppLogWS = oXL.Worksheets("Sheet1")
oNewAppLogWS.Name = "Application Log"
oNewAppLogWS.Range("A1").Value = "Type"
oNewAppLogWS.Range("B1").Value = "Date & Time"
oNewAppLogWS.Range("C1").Value = "Source"
oNewAppLogWS.Range("D1").Value = "Category (Code)"
oNewAppLogWS.Range("E1").Value = "Event ID"
oNewAppLogWS.Range("F1").Value = "User"
oNewAppLogWS.Range("G1").Value = "Computer"
'oNewAppLogWS.Range("H1:O1").Merge()
oNewAppLogWS.Range("H1").Value = "Description"
iRow = 2
'Declare an EventLog and EventLogEntry object
Dim elAppEvent As New System.Diagnostics.EventLog("Application")
Dim elAppEventEntry As System.Diagnostics.EventLogEntry
' Iterate through a collection
For Each elAppEventEntry In elAppEvent.Entries
If Not UCase(elAppEventEntry.EntryType.ToString) =
"INFORMATION" Then
oNewAppLogWS.Cells(iRow, "A") =
elAppEventEntry.EntryType.ToString
oNewAppLogWS.Cells(iRow, "B") =
elAppEventEntry.TimeGenerated.ToString
oNewAppLogWS.Cells(iRow, "C") =
elAppEventEntry.Source.ToString
oNewAppLogWS.Cells(iRow, "D") =
elAppEventEntry.Category.ToString & "(" &
elAppEventEntry.CategoryNumber.ToString & ")"
oNewAppLogWS.Cells(iRow, "E") =
elAppEventEntry.InstanceId.ToString
If elAppEventEntry.UserName Is Nothing Then
oNewAppLogWS.Cells(iRow, "F") = "N/A"
Else
oNewAppLogWS.Cells(iRow, "F") =
elAppEventEntry.UserName.ToString
End If
oNewAppLogWS.Cells(iRow, "G") =
elAppEventEntry.MachineName.ToString
'oNewAppLogWS.Range("H" & iRow & ":O" & iRow).Merge()
oNewAppLogWS.Cells(iRow, "H") =
elAppEventEntry.Message.ToString
iRow = iRow + 1
End If
Next
'Create Header for System Log
oNewSysLogWS = oXL.Worksheets("Sheet2")
oNewSysLogWS.Name = "System Log"
oNewSysLogWS.Range("A1").Value = "Type"
oNewSysLogWS.Range("B1").Value = "Date & Time"
oNewSysLogWS.Range("C1").Value = "Source"
oNewSysLogWS.Range("D1").Value = "Category (Code)"
oNewSysLogWS.Range("E1").Value = "Event ID"
oNewSysLogWS.Range("F1").Value = "User"
oNewSysLogWS.Range("G1").Value = "Computer"
'oNewSysLogWS.Range("H1:O1").Merge()
oNewSysLogWS.Range("H1").Value = "Description"
iRow = 2
'Declare an EventLog and EventLogEntry object
Dim elSysEvent As New System.Diagnostics.EventLog("System")
Dim elSysEventEntry As System.Diagnostics.EventLogEntry
For Each elSysEventEntry In elSysEvent.Entries
If Not UCase(elSysEventEntry.EntryType.ToString) =
"INFORMATION" Then
oNewSysLogWS.Cells(iRow, "A") =
elSysEventEntry.EntryType.ToString
oNewSysLogWS.Cells(iRow, "B") =
elSysEventEntry.TimeGenerated.ToString
oNewSysLogWS.Cells(iRow, "C") =
elSysEventEntry.Source.ToString
oNewSysLogWS.Cells(iRow, "D") =
elSysEventEntry.Category.ToString & "(" &
elSysEventEntry.CategoryNumber.ToString & ")"
oNewSysLogWS.Cells(iRow, "E") =
elSysEventEntry.InstanceId.ToString
If elSysEventEntry.UserName Is Nothing Then
oNewSysLogWS.Cells(iRow, "F") = "N/A"
Else
oNewSysLogWS.Cells(iRow, "F") =
elSysEventEntry.UserName.ToString
End If
oNewSysLogWS.Cells(iRow, "G") =
elSysEventEntry.MachineName.ToString
'oNewSysLogWS.Range("H" & iRow & ":O" & iRow).Merge()
oNewSysLogWS.Cells(iRow, "H") =
elSysEventEntry.Message.ToString
iRow = iRow + 1
End If
Next
oNewWBK.Save()
oNewWBK.Close()
SendMail(strXLNewFile)
Catch ex As Exception
objOutputLog.WriteLine(Err.Number & vbCrLf & ex.Message)
Finally
objOutputLog.writeline(Now() & " Completed")
objOutputLog.Close()
End Try
End Sub
Private Function GetComputerName() As String
Dim objWMI As New clsWMI()
Dim strComputerName As String
With objWMI
strComputerName = .ComputerName
End With
GetComputerName = strComputerName
End Function
Public Sub SendMail(ByVal strXLNewFile As String)
Dim MailClient As New SmtpClient
Dim msg As New Net.Mail.MailMessage
Dim FileAttachment As Attachment
'Dim msgRequestNotification As New Net.Mail.MailMessage
Dim strRecipientEmail As String = "(e-mail address removed)"
Dim strSenderEmail As String = "(e-mail address removed)"
MailClient.Host = "###.###.###.###"
msg.From = New MailAddress(strSenderEmail)
msg.To.Add(New MailAddress(strRecipientEmail))
msg.Priority = MailPriority.High
msg.Subject = " Event Logs for " & GetComputerName() & " on " & Today
msg.Body = ""
FileAttachment = New Attachment(strXLNewFile)
msg.Attachments.Add(FileAttachment)
MailClient.Send(msg)
End Sub
End Module
Please advise.
Many thanks in advance.
Regards,
SB
I have created a script to extract the Event Logs from the system into an
excel sheet. The logs are separated into 2 worksheets (Application Log and
System Log). After this excel file being created, it will be sent out via
email to the list of recipients.
I run the script on my notebook (also developed on th same machine) it works
fine. However, when I copy all the programs into the server which running on
Windows 2000 sp4 with NET Framework 2.0 installed. The error message that I
received was as follow:
-2147467261
Attempted to read or write protected memory. This is often an indication
that other memory is corrupt.
My program code is as follow:
Imports System.Net.Mail
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Diagnostics
Imports Excel
Module Module1
Public strXLFile, strXLNewFile, strOldXLFile, strLogFile As String
Sub Main()
Dim oXL As New Excel.Application
Dim objExcel As Object
Dim objWorkbook As Object
'Dim oNewWBKs As Excel.Workbooks
Dim oNewWBK As Excel.Workbook
Dim oNewAppLogWS As New Excel.Worksheet
Dim oNewSysLogWS As New Excel.Worksheet
Dim iRow As Integer
Dim strComputerName As String
Dim strLogFile As String
Dim objOutputLog As Object
Try
Dim objFSO = CreateObject("Scripting.FileSystemObject")
'Set output log file
strLogFile = objFSO.getSpecialFolder(2).path & "\" &
"EventLogFile.txt"
objOutputLog = New StreamWriter(strLogFile, True)
objOutputLog.WriteLine(vbCrLf & Now() & " : Started")
strComputerName = GetComputerName()
strXLNewFile = objFSO.getSpecialFolder(2).path & "\" &
strComputerName & "-" & Today.ToString("ddMMMyyyy") & "-" &
Now().ToString("HHmm") & ".xls"
'strXLNewFile = "C:\Data\EventLog\" & strComputerName & "-" &
Today.ToString("ddMMMyyyy") & "-" & Now().ToString("HHmm") & ".xls"
objExcel = CreateObject("Excel.Application")
objWorkbook = objExcel.Workbooks.Add
objWorkbook.SaveAs(strXLNewFile)
objExcel.workbooks.close()
objWorkbook = Nothing
objExcel.quit()
objExcel = Nothing
'Create Header for Application Log
oNewWBK = oXL.Workbooks.Open(strXLNewFile)
oNewAppLogWS = oXL.Worksheets("Sheet1")
oNewAppLogWS.Name = "Application Log"
oNewAppLogWS.Range("A1").Value = "Type"
oNewAppLogWS.Range("B1").Value = "Date & Time"
oNewAppLogWS.Range("C1").Value = "Source"
oNewAppLogWS.Range("D1").Value = "Category (Code)"
oNewAppLogWS.Range("E1").Value = "Event ID"
oNewAppLogWS.Range("F1").Value = "User"
oNewAppLogWS.Range("G1").Value = "Computer"
'oNewAppLogWS.Range("H1:O1").Merge()
oNewAppLogWS.Range("H1").Value = "Description"
iRow = 2
'Declare an EventLog and EventLogEntry object
Dim elAppEvent As New System.Diagnostics.EventLog("Application")
Dim elAppEventEntry As System.Diagnostics.EventLogEntry
' Iterate through a collection
For Each elAppEventEntry In elAppEvent.Entries
If Not UCase(elAppEventEntry.EntryType.ToString) =
"INFORMATION" Then
oNewAppLogWS.Cells(iRow, "A") =
elAppEventEntry.EntryType.ToString
oNewAppLogWS.Cells(iRow, "B") =
elAppEventEntry.TimeGenerated.ToString
oNewAppLogWS.Cells(iRow, "C") =
elAppEventEntry.Source.ToString
oNewAppLogWS.Cells(iRow, "D") =
elAppEventEntry.Category.ToString & "(" &
elAppEventEntry.CategoryNumber.ToString & ")"
oNewAppLogWS.Cells(iRow, "E") =
elAppEventEntry.InstanceId.ToString
If elAppEventEntry.UserName Is Nothing Then
oNewAppLogWS.Cells(iRow, "F") = "N/A"
Else
oNewAppLogWS.Cells(iRow, "F") =
elAppEventEntry.UserName.ToString
End If
oNewAppLogWS.Cells(iRow, "G") =
elAppEventEntry.MachineName.ToString
'oNewAppLogWS.Range("H" & iRow & ":O" & iRow).Merge()
oNewAppLogWS.Cells(iRow, "H") =
elAppEventEntry.Message.ToString
iRow = iRow + 1
End If
Next
'Create Header for System Log
oNewSysLogWS = oXL.Worksheets("Sheet2")
oNewSysLogWS.Name = "System Log"
oNewSysLogWS.Range("A1").Value = "Type"
oNewSysLogWS.Range("B1").Value = "Date & Time"
oNewSysLogWS.Range("C1").Value = "Source"
oNewSysLogWS.Range("D1").Value = "Category (Code)"
oNewSysLogWS.Range("E1").Value = "Event ID"
oNewSysLogWS.Range("F1").Value = "User"
oNewSysLogWS.Range("G1").Value = "Computer"
'oNewSysLogWS.Range("H1:O1").Merge()
oNewSysLogWS.Range("H1").Value = "Description"
iRow = 2
'Declare an EventLog and EventLogEntry object
Dim elSysEvent As New System.Diagnostics.EventLog("System")
Dim elSysEventEntry As System.Diagnostics.EventLogEntry
For Each elSysEventEntry In elSysEvent.Entries
If Not UCase(elSysEventEntry.EntryType.ToString) =
"INFORMATION" Then
oNewSysLogWS.Cells(iRow, "A") =
elSysEventEntry.EntryType.ToString
oNewSysLogWS.Cells(iRow, "B") =
elSysEventEntry.TimeGenerated.ToString
oNewSysLogWS.Cells(iRow, "C") =
elSysEventEntry.Source.ToString
oNewSysLogWS.Cells(iRow, "D") =
elSysEventEntry.Category.ToString & "(" &
elSysEventEntry.CategoryNumber.ToString & ")"
oNewSysLogWS.Cells(iRow, "E") =
elSysEventEntry.InstanceId.ToString
If elSysEventEntry.UserName Is Nothing Then
oNewSysLogWS.Cells(iRow, "F") = "N/A"
Else
oNewSysLogWS.Cells(iRow, "F") =
elSysEventEntry.UserName.ToString
End If
oNewSysLogWS.Cells(iRow, "G") =
elSysEventEntry.MachineName.ToString
'oNewSysLogWS.Range("H" & iRow & ":O" & iRow).Merge()
oNewSysLogWS.Cells(iRow, "H") =
elSysEventEntry.Message.ToString
iRow = iRow + 1
End If
Next
oNewWBK.Save()
oNewWBK.Close()
SendMail(strXLNewFile)
Catch ex As Exception
objOutputLog.WriteLine(Err.Number & vbCrLf & ex.Message)
Finally
objOutputLog.writeline(Now() & " Completed")
objOutputLog.Close()
End Try
End Sub
Private Function GetComputerName() As String
Dim objWMI As New clsWMI()
Dim strComputerName As String
With objWMI
strComputerName = .ComputerName
End With
GetComputerName = strComputerName
End Function
Public Sub SendMail(ByVal strXLNewFile As String)
Dim MailClient As New SmtpClient
Dim msg As New Net.Mail.MailMessage
Dim FileAttachment As Attachment
'Dim msgRequestNotification As New Net.Mail.MailMessage
Dim strRecipientEmail As String = "(e-mail address removed)"
Dim strSenderEmail As String = "(e-mail address removed)"
MailClient.Host = "###.###.###.###"
msg.From = New MailAddress(strSenderEmail)
msg.To.Add(New MailAddress(strRecipientEmail))
msg.Priority = MailPriority.High
msg.Subject = " Event Logs for " & GetComputerName() & " on " & Today
msg.Body = ""
FileAttachment = New Attachment(strXLNewFile)
msg.Attachments.Add(FileAttachment)
MailClient.Send(msg)
End Sub
End Module
Please advise.
Many thanks in advance.
Regards,
SB