Vba code to extract email from archive

[Xlsin]

Hi All,

I am looking for extracting email from archive folder of outlook. Though I have tried few codes present in forum, it is not working as in defaultfolder command archive is not there. Also please let me know if there is any way to extract all the email from all folders starting with "Action" in subject line for date ranging before a week. I am not attaching as it is mainly on outlook and no data to deal in excel.

 

[Xlsin]

Note: Replace "YourArchivePST" with the name of your PST file and "ArchiveFolder" with the name of your archive folder.

Sub ExtractEmails()
  Dim olApp As Outlook.Application
  Dim olNS As Namespace
  Dim Fldr As MAPIFolder
  Dim SubFldr As MAPIFolder
  Dim itm As Object

  Set olApp = New Outlook.Application
  Set olNS = olApp.GetNamespace("MAPI")

  Set Fldr = olNS.Folders("YourArchivePST").Folders("ArchiveFolder")

  For Each SubFldr In Fldr.Folders
    For Each itm In SubFldr.Items
      If TypeOf itm Is MailItem Then
        'Do something with the email item
      End If
    Next itm
  Next SubFldr

  Set Fldr = Nothing
  Set olNS = Nothing
  Set olApp = Nothing
End Sub

To extract emails with a subject line starting with "Action" and received in the past week, you can modify the code as follows:

Sub ExtractEmails()
  Dim olApp As Outlook.Application
  Dim olNS As Namespace
  Dim Fldr As MAPIFolder
  Dim SubFldr As MAPIFolder
  Dim itm As Object
  Dim dtCutoff As Date

  dtCutoff = Date - 7

  Set olApp = New Outlook.Application
  Set olNS = olApp.GetNamespace("MAPI")

  Set Fldr = olNS.Folders("YourArchivePST").Folders("ArchiveFolder")

  For Each SubFldr In Fldr.Folders
    For Each itm In SubFldr.Items
      If TypeOf itm Is MailItem Then
        If itm.ReceivedTime >= dtCutoff And itm.Subject Like "Action*" Then
          'Do something with the email item
        End If
      End If
    Next itm
  Next SubFldr

  Set Fldr = Nothing
  Set olNS = Nothing
  Set olApp = Nothing
End Sub

Hi thank you for the response but archive one is still showing error. Is there any way to extract emails from all folders of outlook at a time starting with Action