Jump to content
HighlanderSword

Convert Outlook Vba to use Outlookex

Recommended Posts

HighlanderSword

Hello,

 

I have the code below that works great in outlook VBA Project, I want to convert this over to use outlookex

This basically goes thru the outlook folder grabs the parent folder name for each parent folder , then creates a new pst

and re-creates all of the Parent folder and the subfolders underneath.

 

I'm ok creating the pst using outlookex , after that is where i get lost, appreciate any guidance

 

' Creates a new Outlook PST named after the windows username and current year
' Binds the new PST to Outlook and copies the directory structure to the new PST

' filename: make_new_pst.vbs

Const olFolderInbox = 6

'Grab the user name
Set wSHNetwork = CreateObject("WScript.Network")
strUser = WSHNetwork.UserName

'grab user profile
Set oShell = CreateObject("Wscript.Shell")
strUserProfile = oShell.ExpandEnvironmentStrings("%USERPROFILE%")

pstName = strUser & "_" & Year(now)
strPSTPath = strUserProfile & "\Local Settings\Application Data\Microsoft\Outlook\" & pstName & ".pst"

' win7/vista:
'strPSTPath = strUserProfile & "\AppData\Local\Microsoft\Outlook\" & pstName & ".pst"

'hook into MAPI and create pst
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
objNameSpace.AddStoreEx strPSTPath, 2

'Renames PST File To Unique Display Name 
Set pstrename = objNameSpace.Folders.GetLast
pstrename.name = pstName

'Set Namspace to Default Mailbox Inbox Folder 
Set objOldInbox = objNamespace.GetDefaultFolder(olFolderInbox)    
strOldFolderName = objOldInbox.Parent

'Sets Default to Mailbox Root vs Inbox. Must bind to inbox like above first Before Parent Below this is by design
Set objOldMailbox = objNamespace.Folders(strOldFolderName)    
     
'set collection for mailbox contents at root
Set colOldFolders = objOldMailbox.Folders

' set destination PST
Set destPst = objNameSpace.folders(pstName)

' loop through each folder in original PST   
For Each objFolder In colOldFolders

    ' only create 'else' folders
    select case objFolder.Name
        case "Calendar"
        case "Contacts"
        case "Deleted Items"
        case "Journal"
        case "Junk E-Mail"
        case "Notes"
        case "Outbox"
        case "RSS Feeds"
        case "Sent Items"
        case "Tasks"
        case else
            copyFolders objFolder, destPst
    end select
           
Next

'clean things up
Set objNameSpace = Nothing
Set objOutlook = Nothing


' creates all subfolders recursively
Sub copyFolders(pObjFolder, pDestPst)
    Set myNewFolder = pDestPst.Folders.Add(pObjFolder.Name)
    For Each SubFolder in pObjFolder.Folders
        copyFolders SubFolder, pDestPst.Folders(myNewFolder.Name)
    Next
End Sub

 

Share this post


Link to post
Share on other sites
water

So you just want to create the folder structure in the destination PST without copying the content?


My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-06-01 - Version 1.4.9.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-01-27 - Version 1.3.3.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2015-04-01 - Version 0.4.0.0) - Download - General Help & Support - Example Scripts
Excel - Example Scripts - Wiki
Word - Wiki
PowerPoint (2015-06-06 - Version 0.0.5.0) - Download - General Help & Support

Tutorials:
ADO - Wiki

 

Share this post


Link to post
Share on other sites
HighlanderSword

Yes !!!

Share this post


Link to post
Share on other sites
HighlanderSword

Any Luck converting the code ?

Share this post


Link to post
Share on other sites
Juvigy

I would say this is a lot faster and easier to convert:

 

Sub Archive_Outlook_eMails_To_Backup_PST_Folder()
    ' Declare Objects
    Dim SourceFolder As Outlook.MAPIFolder, DestFolder As Outlook.MAPIFolder
    Dim MailItem As Outlook.MailItem
    Dim SourceMailBoxName As String, DestMailBoxName As String
    Dim Source_Pst_Folder_Name As String, Dest_Pst_Folder_Name  As String
    Dim MailsCount As Double, NumberOfDays As Double

    'Set Number of days for aging check
    NumberOfDays = 1

    'Source Mailbox or PST name
    SourceMailBoxName = "YourEmailAccount@gmail.com"
    Source_Pst_Folder_Name = "SourcePSTFolder"
    Set SourceFolder = Outlook.Session.Folders(SourceMailBoxName).Folders(Source_Pst_Folder_Name)

    'Backup to this Mailbox or PST name
    DestMailBoxName = "Archive Folders"
    Dest_Pst_Folder_Name = "Inbox"
    Set DestFolder = Outlook.Session.Folders(DestMailBoxName).Folders(Dest_Pst_Folder_Name)

    MailsCount = SourceFolder.Items.Count
    While MailsCount > 0

        'Backup Mails Older than "Number of Days"
        Set MailItem = SourceFolder.Items.Item(MailsCount)
        If VBA.DateValue(VBA.Now) - VBA.DateValue(MailItem.ReceivedTime) >= NumberOfDays Then
            SourceFolder.Items.Item(MailsCount).Move DestFolder
        End If

        MailsCount = MailsCount - 1
    Wend

    MsgBox "Mailes in " & Source_Pst_Folder_Name & " are Processed"
End Sub

When you play with the numberofdays parameter is such a way that  no mails to be moved , it will only create the folder structure in the PST. At least this is how it works when you do it from the Outlook GUI, i wonder if it going to work via the converted vba code the same way.

Share this post


Link to post
Share on other sites
water
3 hours ago, HighlanderSword said:

Any Luck converting the code ?

Unfortunately I didn't find the required spare time to translate the code :(
Hope I will be able to start working on it in the next few days .


My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-06-01 - Version 1.4.9.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-01-27 - Version 1.3.3.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2015-04-01 - Version 0.4.0.0) - Download - General Help & Support - Example Scripts
Excel - Example Scripts - Wiki
Word - Wiki
PowerPoint (2015-06-06 - Version 0.0.5.0) - Download - General Help & Support

Tutorials:
ADO - Wiki

 

Share this post


Link to post
Share on other sites
water

@Juvigy
Does this VBA code work for subfolders as well?


My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-06-01 - Version 1.4.9.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-01-27 - Version 1.3.3.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2015-04-01 - Version 0.4.0.0) - Download - General Help & Support - Example Scripts
Excel - Example Scripts - Wiki
Word - Wiki
PowerPoint (2015-06-06 - Version 0.0.5.0) - Download - General Help & Support

Tutorials:
ADO - Wiki

 

Share this post


Link to post
Share on other sites
HighlanderSword

Yes the code I posted does work on the subfolders as well.

Share this post


Link to post
Share on other sites
water

I was addressing Juvigy ;)


My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-06-01 - Version 1.4.9.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-01-27 - Version 1.3.3.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2015-04-01 - Version 0.4.0.0) - Download - General Help & Support - Example Scripts
Excel - Example Scripts - Wiki
Word - Wiki
PowerPoint (2015-06-06 - Version 0.0.5.0) - Download - General Help & Support

Tutorials:
ADO - Wiki

 

Share this post


Link to post
Share on other sites
HighlanderSword

ok, thanks, key thing to note I'm looking for only true mail folders , not calendars , tasks etc....

 

Think you will have any time this week to convert the code

Edited by HighlanderSword

Share this post


Link to post
Share on other sites
water

BTW:
For archiving purposes the OutlookEX UDF offers two functions: _OL_FolderArchiveGet and _OL_FolderArchiveSet.
This allows to let Outlook do the archiving automatically.


My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-06-01 - Version 1.4.9.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-01-27 - Version 1.3.3.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2015-04-01 - Version 0.4.0.0) - Download - General Help & Support - Example Scripts
Excel - Example Scripts - Wiki
Word - Wiki
PowerPoint (2015-06-06 - Version 0.0.5.0) - Download - General Help & Support

Tutorials:
ADO - Wiki

 

Share this post


Link to post
Share on other sites
Juvigy

In Outlook when you do "archive" but choose a condition ">date that is the future" it will create the folder structure and dont move any mail to the PST.

@Water, does _OL_FolderArchiveGet and _OL_FolderArchiveSet  have the same behavior ?

Otherwise the above vba code i posted should be creating the folder structure ONLY if you select a future 'older than date' condition. I haven't been able to test it though!

  • Like 1

Share this post


Link to post
Share on other sites
water

I wasn't able to test those _OL_FolderArchive* functions as well.
It seems I only translated this functions from MS example scripts ;)


My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-06-01 - Version 1.4.9.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-01-27 - Version 1.3.3.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2015-04-01 - Version 0.4.0.0) - Download - General Help & Support - Example Scripts
Excel - Example Scripts - Wiki
Word - Wiki
PowerPoint (2015-06-06 - Version 0.0.5.0) - Download - General Help & Support

Tutorials:
ADO - Wiki

 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×