Макрос для сохранения писем из Outlook.

[GoreProgrammist]

Уважаемые программисты, не могли бы вы помочь мне разобраться со скриптом. Нужно что бы скрипт сохранял все письма из определённой папки ("TestFolder"), созданной в папке Inbox в txt на жёсткий диск компьютера.

Sub SaveAsTXT()
    Dim myOlApp As New Outlook.Application
    Dim myItem As Outlook.Inspector
    Dim objItem As Object
    Set myItem = myOlApp.ActiveInspector
    If Not TypeName(myItem) = "Nothing" Then
        Set objItem = myItem.CurrentItem
        strname = objItem.Subject
        'Prompt the user for confirmation
        Dim strPrompt As String
        strPrompt = "Are you sure you want to save the item?" & _
        "If a file with the same name already exists, " & _
        "it will be overwritten with this copy of the file."	
        If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
            objItem.SaveAs "C:\" &  strname & ".txt", olTXT
        End If
    Else
        MsgBox "There is no current active inspector."
    End If
End Sub

Этот скрипт использует myOlApp.ActiveInspector для того что бы сохранить текущее открытое письмо, я подозреваю что вместо него нужно использовать Mail Item Object, но у меня не получилось сделать так что бы код заработал.

С уважением, Кирилл.

[doober]

Нашел у себя в примерах.
С Outlook никогда не работал,проверить не могу-Outlook-не установлен,с ним не раьотаю
Может поможет код

Private Sub CommandButton1_Click()

        Dim m As New Outlook.Application
        Dim OLObject As Outlook.Namespace
       OLObject = m.GetNamespace("MAPI")
   
        Dim inbox As Outlook.MAPIFolder
      inbox = OLObject.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
       
      Dim msg As Outlook.MailItem
    For Each msg In inbox.Items
            Dim str As String
           str = msg.Subject
            If str = "TT mobile alarms" And msg.UnRead Then
             
                msg.UnRead = False
                TextBox1.Text = msg.Body
            End If
        Next
End Sub