Read email body and extract data from it to excel

[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