Okay so here is the code that I've been trying to make work to extract data from certain e-mails and put it into a master Excel file:
Public Sub Outlook_Automation(oMail As MailItem)
Const sExcelFile As String = "\\Quality\Recording Test1.xlsx"
Const sRecordSheet As String = "Sheet1" '
Dim oExcel As Excel.Application, oWB As Excel.Workbook, oWS As Excel.Worksheet
Dim arrTxt As Variant, oLine As Variant, iR As Long, iC As Long, bWrite As Boolean
Set oExcel = CreateObject("excel.application")
Set oWB = oExcel.Workbooks.Open(FileName:=sExcelFile)
Set oWS = oWB.Worksheets(sRecordSheet)
oExcel.Visible = True
iR = oWS.Cells(Rows.Count, 1).End(xlUp).Row + 1
Debug.Print oMail.Body
oWS.Cells(iR, 1).Value = oMail.ReceivedTime
arrTxt = Split(oMail.Body, vbCrLf)
For Each oLine In arrTxt
bWrite = False
If InStr(1, oLine, "Moisture", vbTextCompare) Then
iC = 2
bWrite = True
ElseIf InStr(1, oLine, "Ash", vbTextCompare) Then
iC = 3
bWrite = True
ElseIf InStr(1, oLine, "Sulfur", vbTextCompare) Then
iC = 4
bWrite = True
ElseIf InStr(1, oLine, "VM", vbTextCompare) Then
iC = 5
bWrite = True
End If
If bWrite Then
oWS.Cells(iR, iC).Value = Split(oLine, ":")(1)
End If
Next
Set oWS = Nothing
oWB.Close True
Set oWB = Nothing
Set oExcel = Nothing
If Err.Number = 0 Then
oMail.UnRead = False
Else
MsgBox "ERR(" & Err.Number & ":" & Err.Description & ") while processing " & oMail.Subject
Err.Clear
End If
End Sub
I have been running into several issues. First is that in order for the script to fill the cells, cell A1 needs to be selected in the Excel doc before I save and close it. The biggest issue comes from when I try to have subsequent e-mails come in. The script stops and the error says "Method 'Rows' of object '_Global' failed." When I run debug it points to the line "iR = oWS.Cells(Rows.Count, 1).End(xlUp).Row + 1" and I am not sure how to modify it so that it will work.
Thanks, you guys are the best!
Bookmarks