I can't find the answer to this question on the internet so I guess it's probably a weird one:
Basically I want my macro to link my archive folders in outlook to a folder on a hard drive, every week I save my new e-mails in the folder and I don't want to have to put in the folder path every time. For the moment I put in the folderpath directly in the vba code. I would like to make it more userfriendly and have a userform ask for a folderpath if the macro doesn't "know" it yet. Then the folderpath has to be saved somewhere so that when I open and close outlook the macro can still acces it. How and where can I save it?
for the moment my (ugly and I know it) code looks like this:
Sub SaveEmailFOLDER_ProcessAllSubFolders() Dim st As Currency, et As Currency st = myTimer Dim Employees As Collection Set Employees = New Collection 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() As String 'pre-assigning variable, I assume a files of less than 15000 e-mails Dim Count As Long Dim MailsAdded As Long Dim fld As Outlook.MAPIFolder Set fld = Application.ActiveExplorer.CurrentFolder 'MsgBox fld.Name 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 Set ChosenFolder = fld If ChosenFolder Is Nothing Then MsgBox "Tu n'as pas sélectionné de dossier espèce d'imbécile!" GoTo ExitSub: ElseIf ChosenFolder.Name = "BATANGAS" Then StrSavePath = "\\D10.tes.local\te\INFRA\Data\DGP\P_005475_BATANGAS_LNG\Emails" ElseIf ChosenFolder.Name = "BNP" Then StrSavePath = "\\D10.tes.local\te\INFRA\Data\DGP\P_005304_BNPPARIBAS\Mails" Else MsgBox "Please assign folder!" GoTo ExitSub: 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(0) = "" Then ' the list is only made once for each subfolder in outlook 'MsgBox "ok" ReDim NameList(0 To mySource.Files.Count) For Each myFile In mySource.Files 'MsgBox Employees.Item(1) 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 = 0 To Count 'If Employees.Item(p) = StrReceived & "-" & StrSender & "_" & StrName & ".msg" Then 'MsgBox "trouvé" 'Employees.Remove (p) 'GoTo SaveTime 'End If 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 et = myTimer 'MsgBox Format(myElapsedTime(et - st), "0.000000") & " seconds" If MailsAdded = 0 Then MsgBox "Folder was already up to date you dumb ****! Stop wasting my time!" Else MsgBox MailsAdded & "/" & Count & " mails added to folder in " & Format(myElapsedTime(et - st), "0.000") & " seconds (way faster than you bitch)! " & vbNewLine & " Folder is up to date!" End If ExitSub: End Sub