Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Thread Tools Display Modes
Old 11-16-2023, 03:33 PM
derek_123 derek_123 is offline VBA to look into shared mailbox Windows 10 VBA to look into shared mailbox Office 2016
VBA to look into shared mailbox
Join Date: Nov 2023
Posts: 2
derek_123 is on a distinguished road
Default VBA to look into shared mailbox

Hi There,

I am using the below outlook vba code to look into Shared mailbox emails and copy data from email body to excel . The code works fine if I am using personal mailbox but it gives Runtime error "The attempted operation failed. An object could not be found" if I use the shared mailbox in the highlighted line. Can anyone please let me know what changes need to be made to make it work for shared mailbox .
Public Sub Extract()
    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 j As Integer
    Dim m As String
    Dim InputF As String
    Dim OutputP 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
    On Error GoTo 0
    '~~> Open the relevant file
    Set oXLwb = oXLApp.Workbooks.Open("C:\ETest.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")
    lRow = 2
    oXLws.Range("A1").Value = "Name"
    oXLws.Range("B1").Value = "ID"
    oXLws.Range("C1").Value = "Address"
    oXLws.Range("D1").Value = "Phone Number"
   If SubFolder.Items.Count = 0 Then
      MsgBox "There are no emails in the " & InputFolder & " folder", , "No Emails"
      Exit Sub
   End If
    For I = 1 To SubFolder.Items.Count
        messageArray = ""
        strRowData = ""
        Set myitem = SubFolder.Items(1)
        msgtext = Trim(myitem.Body)
       'search for specific text
        delimtedMessage = Replace(Trim(msgtext), "A1", "###")
        delimtedMessage = Replace(Trim(delimtedMessage), "B1", "###")
        delimtedMessage = Replace(Trim(delimtedMessage), "C1", "###")
        delimtedMessage = Replace(delimtedMessage, "D1", "###")
        messageArray = Split(delimtedMessage, "###")
          With oXLws
                .Range("A" & lRow).Value = messageArray(1)
                .Range("B" & lRow).Value = messageArray(2)
                .Range("C" & lRow).Value = messageArray(3)
                .Range("D" & lRow).Value = messageArray(4)
           End With
            lRow = lRow + 1
        myitem.Move myDestFolder
    Next I
        oXLwb.Close (True)
        MsgBox "The Macro ran successfully."
    End Sub
Reply With Quote

Thread Tools
Display Modes

Similar Threads
Thread Thread Starter Forum Replies Last Post
MS Outlook shared mailbox Eyalt365 Outlook 0 12-29-2020 11:27 AM
Cannot see inbox in shared mailbox Sarengo Outlook 0 06-27-2013 09:59 AM
Moving emails in shared mailbox to personal mailbox hlock Outlook 0 12-12-2012 02:32 PM
shared mailbox rules monkey Outlook 0 03-17-2012 08:57 PM
Using Shared Mailbox hari.ganeshan Outlook 0 04-26-2010 01:36 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 05:35 PM.

Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd. is not affiliated with Microsoft