Extracting recipient emails

[jonny10]

I have a code that running on INBOX and extracting , need to modify it then it will be running on all subfolders. Please..

Private Sub ExtractEmails()
    Dim objNS As Outlook.NameSpace: Set objNS = GetNamespace("MAPI")
    Dim olFolder As Outlook.MAPIFolder
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    Dim Item As Object
    Dim objFileSystem As Object
    Dim strTextFile As String
    Dim objTextFile As Object
       
    'Create a new Text file
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    strTextFile = "C:\test\contacts.txt"
    Set objTextFile = objFileSystem.CreateTextFile(strTextFile, True)
 
    For Each Item In olFolder.Items
        If TypeOf Item Is Outlook.MailItem Then
            Dim oMail As Outlook.MailItem: Set oMail = Item
            'Input the list of extracted email addresses into this Text file
            If InStr(1, oMail.SenderEmailAddress, "@", 0) <> 0 And InStr(1, oMail.SenderEmailAddress, "microsoft", 0) = 0 Then
'                objTextFile.WriteLine oMail.SenderName & "|" & oMail.SenderEmailAddress
                Debug.Print oMail.SenderName & "|" & oMail.SenderEmailAddress
            End If
'          objTextFile.Write (oMail.SenderEmailAddress)
        End If
    Next


    objTextFile.Close
 
    MsgBox "Completed!", vbInformation, "Extract Email Addresses"
End Sub

Private Sub ExtractEmails()
Dim objNS As Outlook.NameSpace: Set objNS = GetNamespace("MAPI")
Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Dim Item As Object
Dim objFileSystem As Object
Dim strTextFile As String
Dim objTextFile As Object

'Create a new Text file
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTextFile = "C:\test\contacts.txt"
Set objTextFile = objFileSystem.CreateTextFile(strTextFile, True)

For Each Item In olFolder.Items
If TypeOf Item Is Outlook.MailItem Then
Dim oMail As Outlook.MailItem: Set oMail = Item
'Input the list of extracted email addresses into this Text file
If InStr(1, oMail.SenderEmailAddress, "@", 0) <> 0 And InStr(1, oMail.SenderEmailAddress, "microsoft", 0) = 0 Then
' objTextFile.WriteLine oMail.SenderName & "|" & oMail.SenderEmailAddress
Debug.Print oMail.SenderName & "|" & oMail.SenderEmailAddress
End If
' objTextFile.Write (oMail.SenderEmailAddress)
End If
Next


objTextFile.Close

MsgBox "Completed!", vbInformation, "Extract Email Addresses"
End Sub