Sub SaveEmailFOLDER_ProcessAllSubFolders()
     
    Dim i               As Long
    Dim j               As Long
    Dim n               As Long
    Dim StrSubject      As String
    Dim StrName         As String
    Dim StrFile         As String
    Dim StrReceived     As String
    Dim StrSavePath     As String
    Dim StrFolder       As String
    Dim StrFolderPath   As String
    Dim StrSaveFolder   As String
    Dim Prompt          As String
    Dim Title           As String
    Dim StrSender       As String
    Dim iNameSpace      As NameSpace
    Dim myOlApp         As Outlook.Application
    Dim SubFolder       As MAPIFolder
    Dim mItem           As MailItem
    Dim FSO             As Object
    Dim ChosenFolder    As Object
    Dim Folders         As New Collection
    Dim EntryID         As New Collection
    Dim StoreID         As New Collection
    Dim myObject        As Object
    Dim mySource        As Object
    Dim myFile          As Object
    Dim p               As Long
    Dim NameList(15000)       As String 'pre-assigning variable, I assume a files of less than 15000 e-mails
    Dim Count As Long
    Dim MailsAdded As Long
    
    
    p = 0
    
    
    'Set myObject = CreateObject("Scripting.FileSystemObject")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myOlApp = Outlook.Application
    Set iNameSpace = myOlApp.GetNamespace("MAPI")
    Set ChosenFolder = iNameSpace.PickFolder
       
   

 If ChosenFolder Is Nothing Then 
GoTo ExitSub:
    ElseIf ChosenFolder.Name = "BATANGAS" Then ' if I choose the "batangas" 'folder the mails are saved to a specified place on the hard drive
    StrSavePath = "\\D10.tes.local\te\INFRA\Data\DGP\P_005475_BATANGAS_LNG\Emails"

    End If
    
    Prompt = "Please enter the path to save all the emails to."
    Title = "Folder Specification"
    
    If StrSavePath = "" Then
GoTo ExitSub:
    ElseIf Not FileFolderExists(StrSavePath) Then
        MsgBox StrSavePath & " fichier n'existe pas ou mauvaise adresse dans vba!"
GoTo ExitSub:
    End If
    
    If Not Right(StrSavePath, 1) = "\" Then
        StrSavePath = StrSavePath & "\"
    End If
     
    Call GetFolder(Folders, EntryID, StoreID, ChosenFolder) ' All subfolders of outlook and the main folder are checked for e-mails
     
    For i = 1 To Folders.Count
        
        StrFolder = StripIllegalChar(Folders(i))
        'MsgBox i & " " & StrFolder
        n = InStr(3, StrFolder, "\") + 1
        StrFolder = Mid(StrFolder, n, 256)
        StrFolderPath = StrSavePath '& StrFolder & "\"      ' I do not use strfolder, all subfolders in outlook are saved in the same folder on the hard drive
        'MsgBox StrFolderPath
        'MsgBox StrFolder
        'MsgBox i & "  " & StrFolder
        
        StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\"
        
        If Not FSO.FolderExists(StrFolderPath) Then
            FSO.CreateFolder (StrFolderPath)
        End If
        
        
        
        Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i))
        Set mySource = FSO.GetFolder(StrSaveFolder)
        On Error Resume Next
        On Error Resume Next
        
        If NameList(1) = "" Then
        'MsgBox i
        For Each myFile In mySource.Files
            NameList(Count) = myFile.Name
            Count = Count + 1
        Next
        End If
        
        For j = 1 To SubFolder.Items.Count
            
            Set mItem = SubFolder.Items(j)
            StrReceived = StripIllegalChar(Left(mItem.ReceivedTime, 10))
            StrReceived = Format(mItem.ReceivedTime, "YYYYMMDD-hhmm")
            StrSender = Left(mItem.SenderName, 15)
            StrSubject = mItem.Subject
            StrName = StripIllegalChar(StrSubject)
            StrFile = StrSaveFolder & StrReceived & "-" & StrSender & "_" & StrName & ".msg"
            'MsgBox StrFile
            
            StrFile = Left(StrFile, 256)
          
            
            'MsgBox mySource.Name
            

            
            For p = 1 To Count
                If NameList(p) = StrReceived & "-" & StrSender & "_" & StrName & ".msg" Then
                    GoTo SaveTime
                End If
            Next p

            
            MailsAdded = MailsAdded + 1
            mItem.SaveAs StrFile, 3
SaveTime:
        Next j
        On Error GoTo 0
    Next i
    
    MsgBox MailsAdded & "/" & Count & " mails added to folder, folder is up to date!"
     
ExitSub:
     
End Sub