Read email body and extract data from it to excel

[Derek_123]

Hello,

I stuck at extracting email body from outlook to excel. Can anyone please help me with this ? I'm getting runtime error 1004
at a line highlighted as red.

Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
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("\\B:\Test WB.xlsx")
'Set the relevant output sheet. Change as applicable
Set oXLws = oXLwb.Sheets("Output")
lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row
lRow = lRow + 1

Thank You.

[June7]

Where are you running this code? In Access?

Why are you prefixing drive letter with two backslashes? Remove them. Double backslash is used for UNC pathing.

Advise not to begin variable names with number. Could cause issue with MsgBox and Debug.Print and maybe elsewhere.

[Aussiebear]

@June7. The variable names are starting with o not 0. Derek_123 is simply following the programming concept of defining the variable name as o for object.

@Derek_123. Does this work to remove the error from the line in red?

 lRow = oXLWs.Range("A" & .Rows.Count).End(xlUp).Row

[June7]

I was talking about variable 1Row - that starts with number. Ooops, must be a lower case "l". I would use lngR as variable name.
I know the Outlook variables start with lower case "o".

OP's code does work for me, after I removed double backslashes from filepath.

Why would you expect removing qualifier would be better?

[Aussiebear]

it all shows as lRow here

[June7]

In VBA code the number 1 and lower case "l" look almost the same:

1 this is number
l this is letter

I confirmed that VBA will not accept a variable beginning with number so must be lower case "l"

[Derek_123]

I tried below line of code but still getting runtime error 1004, application defined or object defined .

lRow = oXLws.Range("A" & oXLws.Rows.Count).End(xlUp).Row

@June7. The variable names are starting with o not 0. Derek_123 is simply following the programming concept of defining the variable name as o for object.

@Derek_123. Does this work to remove the error from the line in red?

 lRow = oXLWs.Range("A" & .Rows.Count).End(xlUp).Row

[June7]

Did you remove double backslash as recommended in post 2?

Do not remove object qualifier.

[Derek_123]

There are no backslashes in the actual code, It looks like below but the error application defined and object defined keeps on occurring at the line colored red.

Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
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("B:\Test WB.xlsx")
'Set the relevant output sheet. Change as applicable
Set oXLws = oXLwb.Sheets("Output")
lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row

lRow = lRow + 1

Any help will be much appreciated.

[Aussiebear]

Not tested but try

Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
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("B:\Test WB.xlsx")
'Set the relevant output sheet. Change as applicable
Set oXLws = oXLwb.Sheets("Output")
With Sheets(“Output”)
    lRow = Cells(Rows.Count,1).End(xlUp).Row
End With
lRow = lRow + 1

I believe the problem with the line in red in post #9 is that you are using the variable oXLApp which you have earlier set as an Excel Application where as rows.count happens at the sheet level. Someone will correct me here I guess

[June7]

Whichever it is, need to fully qualify object references. If you use With structure, don't forget dot prefix. Use the oXLws object variable. As I already stated. OP's original code works for me - after removing double backslashes and using my folder and file names.

I expect the oXLApp prefix means code acts on whichever sheet has focus. So better to qualify with sheet reference.

Changing oXLApp to oXLws does seem to run faster.

With oXLws
     lRow = .Cells(.Rows.Count, 1).End(xlUp).Row 
End With

Nothing in code has anything to do with reading email body.

Is this code executed from Outlook?

[Derek_123]

Yes I am executing this code from outlook,I have changed the line of code as per your suggestion but still getting 1004 application defined or object defined error message.

 On Error Resume Next
    
    Set myOlApp = Outlook.Application
    Set mynamespace = myOlApp.GetNamespace("mapi")
  
    Dim strRowData As String
    Dim strDelimiter As String
    Dim myDestFolder As Outlook.Folder
    Dim olRecip As Outlook.Recipient
    Dim ShareInbox As Outlook.MAPIFolder
    Dim SubFolder As Object
    Dim InputFolder As String
    Dim OutputFolder As String
    Dim ProdMail As String
    
    Dim oXLApp As Object, oXLwb As Object, oXLws As Object
    
    Dim lRow As Long
    
    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
    
    '~~> Open the relevant file
    Set oXLwb = oXLApp.Workbooks.Open("B:\\WorkbookTest.xlsx")
           
    'Extract Mailbox and subfolder details from a sheet named as "Folder Details"
    
    Set oXLws = oXLwb.Sheets("Folder Details")
           
    ProdMail = oXLws.Range("B1")
    InputFolder = oXLws.Range("B2")
    OutputFolder = oXLws.Range("B3")
       
       
    strRowData = ""
    
    ' Code to extract emails from specific subfolder within shared folder and copy the data across excel spreadsheet.
    
    Set olRecip = mynamespace.CreateRecipient(ProdMail)
    Set ShareInbox = mynamespace.GetSharedDefaultFolder(olRecip, olFolderInbox) ' Look into Inbox emails
    Set SubFolder = ShareInbox.Folders(InputFolder) 'Change this line to specify folder
    Set myDestFolder = ShareInbox.Folders(OutputFolder)
       
    If ShareInbox.Folders(InputFolder) = 0 Then
       MsgBox "New Apps folder doesn't exist"
       Exit Sub
    End If
    
    If ShareInbox.Folders(OutputFolder) = 0 Then
       MsgBox "Completed Apps folder doesn't exist"
       Exit Sub
    End If
         
    Set oXLws = oXLwb.Sheets("Output")
       
    oXLws.Activate
    
    With oXLws
     lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

Can you help please? Thanks

[June7]

I still cannot reproduce this issue on that line.

Do you have Microsoft Excel reference library selected?

Disable the On Error Resume Next and step debug your code.

[Derek_123]

I didn't have Microsoft excel reference library selected . It's all working now. Thanks a million for all your help .

[Derek_123]

Hi June7,

I am getting unexpected error while trying to run macros as below


And when I debug then it highlights the below line

Set oXLwb = oXLApp.Workbooks.Open("B:\\Workbook1.xlsx")



Can you please help me in this?

Thanks

[Derek_123]

I restarted my laptop and the macro started working again.I have deployed this macro on other user's outlook who is running this on a shared mailbox and he is getting "The attempted operation failed. An object could not be found" error message in below lines of code:

 Set SubFolder = ShareInbox.Folders(InputFolder) 'Change this line to specify folder
    Set myDestFolder = ShareInbox.Folders(OutputFolder)

The macro has no issues finding the shared mailbox, and the Inbox of it but fails to recognize the subfolders within the Inbox. I have made sure they got correct references selected and excel 16.0 object library is also selected . Any help will be much appreciated.
Thanks

[Derek_123]

Can anyone please help me with this issue? The macro runs fine if I am using my personal mailbox but it doesn't work with the shared mailbox Thanks for your help in advance

[June7]

Sorry, I don't have shared mailbox to test with.

[Derek_123]

Sorry, I don't have shared mailbox to test with.

No worries - What do you think could be the issue? Is it linked to settings in a shared mailbox or the code needs to be amended or any reference needs to be added?

Thanks a lot for your help so far.

[June7]

Really have no idea. Never worked with shared mailbox. I can only refer you to documentation and other forum discussions.

https://learn.microsoft.com/en-us/of...ddefaultfolder

https://www.mrexcel.com/board/thread...o-vba.1113044/

Are you sure owner has delegated sharing to others?

Disable error handler code when debugging. Comment On Error Resume Next line.