Public Sub MSG()
    
    Dim objOutlApp As Object, oNSpace As Object, oIncoming As Object
    Dim oIncMails As Object, oMail As Object
    Dim IsNotAppRun As Boolean
    Application.Calculation = xlCalculationManual

    On Error Resume Next
    Set objOutlApp = New Outlook.Application
    If objOutlApp Is Nothing Then ' даже к закрытому
        Set objOutlApp = CreateObject("outlook.Application")
        IsNotAppRun = True
    End If

    Set oNSpace = objOutlApp.GetNamespace("MAPI")
    Set oIncoming = oNSpace.Folders("mail@mail.ru").Folders("ПОСТУПЛЕНИЯ")   
    Set oIncMails = oIncoming.Items    
    
    Dim nn As Long
    nn = oIncMails.Count ' сколько всего пришло писем    
    If nn = 0 Then
        MsgBox "Новых писем - нет", Title:="ПОСТУПЛЕНИЯ"
        Exit Sub
    End If
    I = 1   
    Dim m As Long ' счетчик для цикла
    m = 0    
    For Each oMail In oIncMails
        m = m + 1
        Application.StatusBar = "Обработка " & m & "-го письма из " & nn
    
        ...  ' код обработки
    
'    завершение цикла по строке
    Next
    
End Sub

Sub SendHTTPRequest()
    
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")

    httpReq.Open "GET", "https://m4d.nalog.gov.ru/emchd/get-info/data", False

    httpReq.setRequestHeader "Content-Type", "application/json"

    httpReq.Send

    If httpReq.Status = 200 Then
        Debug.Print httpReq.responseText
    Else
        Debug.Print "Ошибка: " & httpReq.Status
    End If
    
    Set httpReq = Nothing
    
End Sub

'        ПЕРЕИМЕНОВАНИЕ
        On Error Resume Next
        Name inPath & thisFile As inPath & ws.Cells(i, 2) & ".msg"

Option Explicit
'   https://stackoverflow.com/a/35296933

 Sub importMsg()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Dim i As Long
    Dim inPath As String
    Dim thisFile As String
'    Dim Msg As MailItem
    Dim ws As Worksheet
'    Dim myOlApp As Outlook.Application
    Dim myOlApp As Object ' Object/Application
'    Dim MyItem As Outlook.MailItem
    Dim MyItem As Variant ' Variant/Object/MailItem

    Set myOlApp = CreateObject("Outlook.Application")
    Set ws = ThisWorkbook.Worksheets(1)

    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
            If .Show = False Then
                Exit Sub
            End If
        On Error Resume Next
        inPath = .SelectedItems(1) & "\"
    End With
    thisFile = Dir(inPath & "*.msg")
    i = 4

    Sheets(1).Cells.Clear

    Do While thisFile <> ""
        Set MyItem = myOlApp.CreateItemFromTemplate(inPath & thisFile)
        ws.Cells(i, 1) = MyItem.Body
        
'        -----извлечение номера-----
        Dim myRegExp As Object, myObj As Object, myStr1 As Object
        Dim msgText As String, myStr2 As String
        msgText = ws.Cells(i, 1)
        Set myRegExp = CreateObject("VBScript.RegExp")
        With myRegExp
            .Global = True
            .Pattern = "\d{2}\s\d{2}\s[№]\s\d{5,6}"
            Set myObj = .Execute(msgText)
        End With
        For Each myStr1 In myObj
            myStr2 = myStr1.Value
        Next myStr1
        ws.Cells(i, 2) = myStr2
        
'Как здесь переименовывать каждый *.msg в имя из ws.Cells(i, 2) = myStr2?

        i = i + 1
        thisFile = Dir()
    Loop

    Sheets(1).UsedRange.Columns.AutoFit

    Set MyItem = Nothing
    Set myOlApp = Nothing

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub

let
    Источник = Excel.Workbook(File.Contents("C:\Users\1\Desktop\Пример отчета.xlsx"), null, true),
    Лист1_Sheet = Источник{[Item="Лист1",Kind="Sheet"]}[Data],
    #"Повышенные заголовки" = Table.PromoteHeaders(Лист1_Sheet, [PromoteAllScalars=true]),
    #"Измененный тип" = Table.TransformColumnTypes(#"Повышенные заголовки",{{"Отчет ", type any}, {"Column2", type text}, {"Column3", type text}, {"Column4", type text}, {"Column5", type text}, {"Column6", type text}, {"Column7", type text}, {"Column8", type text}, {"Column9", type text}, {"Column10", type text}, {"Column11", type text}, {"Column12", type text}, {"Column13", type text}, {"Column14", type text}, {"Column15", type text}, {"Column16", type text}, {"Column17", type text}, {"Column18", type text}, {"Column19", type text}, {"Column20", type text}, {"Column21", type text}, {"Column22", type text}, {"Column23", type text}, {"Column24", type text}, {"Column25", type text}, {"Column26", type text}, {"Column27", type text}, {"Column28", type text}, {"Column29", type text}, {"Column30", type text}, {"Column31", type text}}),
    #"Удаленные верхние строки" = Table.Skip(#"Измененный тип",1),
    #"Повышенные заголовки1" = Table.PromoteHeaders(#"Удаленные верхние строки", [PromoteAllScalars=true]),
    #"Измененный тип1" = Table.TransformColumnTypes(#"Повышенные заголовки1",{{"столбец1", type any}, {"столбец2", type text}, {"столбец3", Int64.Type}, {"столбец4", type text}, {"столбец5", type text}, {"столбец6", type text}, {"столбец7", type text}, {"столбец8", type text}, {"столбец9", type text}, {"столбец10", type text}, {"столбец11", type text}, {"столбец12", type text}, {"столбец13", type text}, {"столбец14", type text}, {"столбец15", type text}, {"столбец16", type text}, {"столбец17", type text}, {"столбец18", type text}, {"столбец19", type text}, {"столбец20", type text}, {"столбец21", type text}, {"столбец22", type text}, {"столбец23", type text}, {"столбец24", type text}, {"столбец25", type text}, {"столбец26", type text}, {"столбец27", type text}, {"столбец28", type text}, {"столбец29", type text}, {"столбец30", type text}, {"столбец31", type text}}),
    #"Удаленные нижние строки" = Table.RemoveLastN(#"Измененный тип1",11),
    Table.SelectRows(Source, (x)=> List.IsEmpty(List.RemoveMatchingItems({x[столбец3]}, {"11","1011","20501"})))
in
    #"Удаленные нижние строки"