VBA Error when multiple workbooks open

[kelseyvdh]

Hi everyone, I found this almost perfect working code, except for one thing: when I've another workbook open, it gives an error at this line:


Set oXLws = oXLwb.Sheets("Overview")
Would it be possible to make this work without errors when I've already opened several other workbooks?
Here's the full code:

Const xlUp As Long = -4162
Sub ExportToExcel(MyMail As MailItem)
Dim strID As String, olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim strFileName As String
'~~> Excel Variables
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
'~~> Show Excel
oXLApp.Visible = True
'~~> Open the relevant file
Set oXLwb = oXLApp.Workbooks.Open("C:\ HERE'S THE LOCATION")
oXLwb.Activate
On Error Resume Next
Set oXLws = oXLwb.Sheets("Overview")

'~~> Set the relevant output sheet. Change as applicable
On Error Resume Next

lRow = oXLwb.Sheets("Overview").Range("E" & oXLApp.Rows.Count).End(xlUp).Row + 1
'~~> Write to outlook
With oXLwb.Sheets("Overview")
'
'~~> Code here to output data from email to Excel File
'~~> For example
'
.Range("D" & lRow).Value = (Now)
.Range("E" & lRow).Value = olMail.Subject
.Range("G" & lRow).Value = olMail.Body
'
End With
'~~> Close and Clean up Excel
'oXLwb.Close (True)
'oXLApp.Quit
Set oXLws = Nothing
Set oXLwb = Nothing
Set oXLApp = Nothing
Set olMail = Nothing
Set olNS = Nothing
End Sub

Thanks!

[gmayor]

The macro needs a little bit more in the way of error handling (and there is no need to activate the sheet or the workbook when you have defined them with variable names) but otherwise it works. However the bigger problem is that of storing the message body in a cell. That can create all kinds of compatibility issues and is best avoided.


Option Explicit

Const xlUp As Long = -4162
Sub ExportToExcel(MyMail As MailItem)
Dim strID As String, olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim strFileName As String
'~~> Excel Variables
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
'~~> Show Excel
oXLApp.Visible = True
'~~> Open the relevant file

Set oXLwb = oXLApp.Workbooks("C:\Path\Forums\OutlookLog.xlsx")
If oXLwb Is Nothing Then
Set oXLwb = oXLApp.Workbooks.Open("C:\Path\Forums\OutlookLog.xlsx")
End If

For Each oXLws In oXLwb.Sheets
If oXLws.Name = "Overview" Then
Exit For
End If
Next oXLws
If oXLws Is Nothing Then
MsgBox "Worksheet not found"
GoTo lbl_Exit
End If

On Error GoTo 0


lRow = oXLws.Range("E" & oXLApp.Rows.Count).End(xlUp).Row + 1
'~~> Write to outlook
With oXLws
'
'~~> Code here to output data from email to Excel File
'~~> For example
'
.Range("D" & lRow).Value = (Now)
.Range("E" & lRow).Value = olMail.Subject
.Range("G" & lRow).Value = olMail.Body
'
End With
'~~> Close and Clean up Excel
'oXLwb.Close (True)
'oXLApp.Quit
lbl_Exit:
Set oXLws = Nothing
Set oXLwb = Nothing
Set oXLApp = Nothing
Set olMail = Nothing
Set olNS = Nothing
Exit Sub
End Sub