Ik ben op het internet druk aan het zoeken geweest naar een VBA script voor het exporteren van mappen uit mijn publieke folders naar een *.pst.
Omdat het er nogal veel geworden zijn in de laatste jaren wil ik de mappen individueel exporteren naar een *.pst en de naam geven die de map heeft.
De eerste deed ik nog als "Bestand"-"Openen"-"Importeren"-"Naar een bestand exporteren"-enz..... Alleen nog 10 mappen was de "lol" er snel vanaf.
Onderstaande code kwam ik wel tegen op het internet. Alleen gaf niet het wenselijke resultaat.
In excel bevindt zich een opname knop, deze ontbreekt helaas in Outlook.
Omdat het er nogal veel geworden zijn in de laatste jaren wil ik de mappen individueel exporteren naar een *.pst en de naam geven die de map heeft.
De eerste deed ik nog als "Bestand"-"Openen"-"Importeren"-"Naar een bestand exporteren"-enz..... Alleen nog 10 mappen was de "lol" er snel vanaf.
Onderstaande code kwam ik wel tegen op het internet. Alleen gaf niet het wenselijke resultaat.
PHP:
Sub Archief()
'Define some constants'
'On the next line change the path to the folder that will contain the backups. Make sure the path ends with a \'
Const BACKUP_PATH = "C:\Users\fvdh\Desktop\Nieuwe map\"
'Create some variables
Dim strBackupFileName, objFSO, olkApp, olkSes, olkRootFolder, olkFolder, olkFolderCopy, olkBackup
'On the next line change the file name as desired'
strBackupFileName = "BU " & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & ".pst"
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Connect to Outlook'
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
'Main routine'
On Error Resume Next
olkSes.AddStore BACKUP_PATH & strBackupFileName
Set olkBackup = olkSes.Stores.Item("Personal Folders")
olkBackup.Name = strBackupFileName
olkSes.RemoveStore olkBackup
olkSes.AddStore BACKUP_PATH & strBackupFileName
Set olkBackup = olkSes.Stores.Item(strBackupFileName)
Set olkRootFolder = olkSes.DefaultStore.GetRootFolder
For Each olkFolder In olkRootFolder.Folders
Set olkFolderCopy = olkFolder.CopyTo(olkBackup)
Next
olkSes.RemoveStore olkBackup
On Error GoTo 0
'Disconnect from Outlook'
olkSes.Logoff
'Clean-up'
Set objFSO = Nothing
Set olkBackup = Nothing
Set olkRootFolder = Nothing
Set olkFolder = Nothing
Set olkFolderCopy = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
End SubIn excel bevindt zich een opname knop, deze ontbreekt helaas in Outlook.
