Forum Discussion

NikolinoDE's avatar
NikolinoDE
Platinum Contributor
Sep 19, 2023

Re: Replay from excel - Any one ??

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.

4 Replies

  • 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.
      • Amisha35's avatar
        Amisha35
        Copper Contributor
        Excel 365, Windows, file extension is xlsm

Resources