Forum Discussion

Amisha35's avatar
Amisha35
Copper Contributor
Sep 19, 2023

Replay from excel - Any one ??

I just need my own code to search in shared mails also. 

 

I have this VBA code that look up from excel to outlook based on cell value it should find the thread and replay to latest mail. but the issue is that this code look only at my default inbox.  What i need is that excel should look into all the folders and shared folders to find the mail and replay. 

 

 

Sub ReplyAllLastEmailFromInboxAndSent()

Dim olApp As Outlook.Application
Dim SubFolder As Folder
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim objMail As Object
Dim objReplyToThisMail As MailItem
Dim lngCount As Long
Dim objConversation As Conversation
Dim objTable As Table
Dim objVar As Variant
Dim strBody As String
Dim searchFolderName As String

Set olApp = Session.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderSentMail)

searchFolderName = "'" & Outlook.Session.GetDefaultFolder(olFolderInbox).FolderPath & "','" & Outlook.Session.GetDefaultFolder(olFolderSentMail).FolderPath & "'"


lngCount = 1

For Each objMail In Fldr.Items
If TypeName(objMail) = "MailItem" Then
If InStr(objMail.Subject, ActiveCell.Value) <> 0 Then
Set objConversation = objMail.GetConversation
Set objTable = objConversation.GetTable
objVar = objTable.GetArray(objTable.GetRowCount)
Set objReplyToThisMail = olApp.Session.GetItemFromID(objVar(UBound(objVar), 0))
With objReplyToThisMail.ReplyAll
strBody = "Dear " & "<br>" & _
"<p>" & _
"<p>Thank you," & vbCrLf
.HTMLBody = strBody & .HTMLBody
.Display
End With
Exit For
End If
End If
Next objMail

Set olApp = Nothing
Set SubFolder = Nothing
Set olNs = Nothing
Set Fldr = Nothing
Set objMail = Nothing
Set objReplyToThisMail = Nothing
lngCount = Empty
Set objConversation = Nothing
Set objTable = Nothing
If IsArray(objVar) Then Erase objVar

End Sub

 

 

5 Replies

  • NikolinoDE's avatar
    NikolinoDE
    Platinum Contributor

    Amisha35 

    To make your VBA code look in all folders and shared folders for the email thread based on the cell value, you can modify your code to loop through all folders in the mailbox.

    Here's an updated version of your code that does this (code is untested):

    Sub ReplyAllLastEmailFromAllFolders()
    
        Dim olApp As Outlook.Application
        Dim olNs As Namespace
        Dim objMail As Object
        Dim objReplyToThisMail As MailItem
        Dim objConversation As Conversation
        Dim objTable As Table
        Dim objVar As Variant
        Dim strBody As String
        Dim searchValue As String
        
        ' Set your search value based on the cell value
        searchValue = ActiveCell.Value
    
        Set olApp = New Outlook.Application
        Set olNs = olApp.GetNamespace("MAPI")
    
        ' Loop through all folders, including subfolders
        For Each objFolder In olNs.Folders
            ProcessFolder objFolder, searchValue
        Next objFolder
    
        Set olApp = Nothing
        Set olNs = Nothing
        Set objMail = Nothing
        Set objReplyToThisMail = Nothing
        Set objConversation = Nothing
        Set objTable = Nothing
        If IsArray(objVar) Then Erase objVar
    
    End Sub
    
    Sub ProcessFolder(objFolder As Folder, searchValue As String)
        Dim objMail As Object
        Dim objReplyToThisMail As MailItem
        Dim objConversation As Conversation
        Dim objTable As Table
        Dim objVar As Variant
        Dim strBody As String
    
        For Each objMail In objFolder.Items
            If TypeName(objMail) = "MailItem" Then
                If InStr(objMail.Subject, searchValue) <> 0 Then
                    Set objConversation = objMail.GetConversation
                    Set objTable = objConversation.GetTable
                    objVar = objTable.GetArray(objTable.GetRowCount)
                    Set objReplyToThisMail = objFolder.Session.GetItemFromID(objVar(UBound(objVar), 0))
                    With objReplyToThisMail.ReplyAll
                        strBody = "Dear " & "<br>" & _
                                 "<p>" & _
                                 "<p>Thank you," & vbCrLf
                        .HTMLBody = strBody & .HTMLBody
                        .Display
                    End With
                    Exit For
                End If
            End If
        Next objMail
    
        ' Recursively process subfolders
        If objFolder.Folders.Count > 0 Then
            For Each subFolder In objFolder.Folders
                ProcessFolder subFolder, searchValue
            Next subFolder
        End If
    End Sub

    This updated code defines two subroutines: ReplyAllLastEmailFromAllFolders and ProcessFolder. The ReplyAllLastEmailFromAllFolders routine initiates the search through all folders, and the ProcessFolder routine recursively explores subfolders and processes the emails within them.

    Make sure to replace ' Set your search value based on the cell value with the appropriate way to set the searchValue variable based on the value in the active cell.

    This code will search for emails with the specified subject in all folders and subfolders, not just the default Inbox and Sent Items folders. The text, the code and steps were edited with the help of AI.

     

    My answers are voluntary and without guarantee!

     

    Hope this will help you.

    Was the answer useful? Mark them as helpful and like it!

    This will help all forum participants.

    • Amisha35's avatar
      Amisha35
      Copper Contributor

      Dear NikolinoDE 

      Thank you for your help. 

      Why i run the code its came with this error 😕

      • NikolinoDE's avatar
        NikolinoDE
        Platinum Contributor
        More information please about the digital environment. Excel version, operating system, storage medium, file extension, etc.

Resources