Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Sub ResendSelectedReport()
    ' Works in Outlook 2013/2016
    Dim objOL As Outlook.Application
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim myItem As Object
    Dim reportItem As Outlook.reportItem
    Dim objInsp, oInspector As Outlook.Inspector
    Dim olResendMsg As Object ' Using Object to handle both ReportItem and MailItem
    Dim ItemCollection As New Collection
    Dim i As Integer
    Dim ns As Outlook.NameSpace
    Dim inbox As Outlook.MAPIFolder
    Dim resentFolder As Outlook.MAPIFolder

    ' Initialize Outlook application object
    On Error GoTo ErrorHandler
    Set objOL = Outlook.Application
    Set currentExplorer = objOL.ActiveExplorer
    Set Selection = currentExplorer.Selection
    Set ns = objOL.GetNamespace("MAPI")
    Set inbox = ns.GetDefaultFolder(olFolderInbox)
    Set resentFolder = GetFolder(inbox, "ResentToUMA") ' Function to get or create folder

    ' Check if the ResentToUMA folder exists; if not, create it
    If resentFolder Is Nothing Then
        Set resentFolder = inbox.Folders.Add("ResentToUMA", olFolderInbox)
    End If

    On Error GoTo 0

    ' Debugging to check the number of selected items
    Debug.Print "Number of selected items: " & Selection.Count

    ' Store the selected items in a collection to avoid selection issues
    For Each myItem In Selection
        ' Check if the selected item is a ReportItem
        If TypeOf myItem Is Outlook.reportItem Then
            ItemCollection.Add myItem
            Debug.Print "Added ReportItem to collection: " & myItem.Subject
        Else
            Debug.Print "Selected item is not a ReportItem."
        End If
    Next myItem

    ' Debugging to check the number of items added to the collection
    Debug.Print "Number of items in collection: " & ItemCollection.Count

    ' Loop through each item in the collection
    For i = 1 To ItemCollection.Count
        Set reportItem = ItemCollection(i)

        ' Display the report item to run the resend command
        reportItem.Display

        ' Get the Inspector for the displayed item
        Set objInsp = reportItem.GetInspector

        ' Execute the "Send Again" command in Report
        objInsp.CommandBars.ExecuteMso ("SendAgain")

        'A new window opens, where you can Edit and Send
        Set objInsp = Application.ActiveWindow
        'Resend finally
        objInsp.CommandBars.ExecuteMso ("SendDefault")

        'Close Report
        reportItem.Close olDiscard
        ' Move the resent report item to ResentToUMA folder
        reportItem.Move resentFolder

        ' Close the original report item without saving changes
         reportItem.Close olDiscard

        Debug.Print "[" & i & "/" & ItemCollection.Count & "] RESENT - " & CStr(reportItem.CreationTime) & " - " & reportItem.Subject & ""

        'Sleep 1000
    Next i

exitproc:
    ' Clean up
    Set reportItem = Nothing
    Set objInsp = Nothing
    Set olResendMsg = Nothing

    Debug.Print "Process completed."
    Exit Sub

ErrorHandler:
    Debug.Print "Error: " & Err.Number & " - " & Err.Description
    Resume exitproc
End Sub

Function GetFolder(parentFolder As Outlook.MAPIFolder, folderName As String) As Outlook.MAPIFolder
    ' Function to get a subfolder of parentFolder by name; create if it doesn't exist
    Dim subFolder As Outlook.MAPIFolder
    On Error Resume Next
    Set subFolder = parentFolder.Folders(folderName)
    On Error GoTo 0
    If subFolder Is Nothing Then
        Set subFolder = parentFolder.Folders.Add(folderName)
    End If
    Set GetFolder = subFolder
End Function