Addressing Outlook Folders?

[Gasman]

Hi all,
I am trying to cobble together some code to move emails easily in VBA.

I have cobbled together the code below and have managed to get the Outlook folder path eg Inbox\Folder1\Folder2

I want to move the emails in Folder2 to the pst file with the same structure. For now we will assume the structure is there?

What I cannot find out how to do at present is set the destination folder path using the above syntax and not

 Set objDestFolder = objNamespace.Folders("Inbox").Folders(""Folder1").Folders("Folder2")

as I will not know how many levels there might be.

This is mainly for a manager who has levels you would not believe.

I've had it working (not as it is now) with just a folder in the Inbox, but now want to expand it to cover all folders and then eventually create a folder if not present. However one thing at a time.

Anyone able to help please.?

TIA

Sub MoveOldEmails()

    ' Declare all variables.

    Dim objOutlook As Outlook.Application

    Dim objNamespace As Outlook.NameSpace

    Dim objSourceFolder As Outlook.MAPIFolder

    Dim objDestFolder As Outlook.MAPIFolder
    Dim objFolders As Outlook.Folders
    Dim objFolder As Outlook.Folder, objParentFolder As Outlook.Folder

    Dim objVariant As Variant

    Dim lngMovedMailItems As Long

    Dim intCount As Integer, intDays As Integer

    Dim intDateDiff As Integer

    Dim strDestFolder As String, strFolderName As String, strFolder As String, strpath As String


    ' Create an object for the Outlook application.

    Set objOutlook = Application

    ' Retrieve an object for the MAPI namespace.

    Set objNamespace = objOutlook.GetNamespace("MAPI")

    ' Retrieve a folder object for the source folder.

    'Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
    strFolderName = Application.ActiveExplorer.CurrentFolder.Name
    Set objSourceFolder = Application.ActiveExplorer.CurrentFolder
    
'    ' Get full path
    strpath = strFolderName
    Set objParentFolder = objSourceFolder.Parent
    Do Until strFolder = "Personal Folders"
        strpath = objParentFolder.Name & "\" & strpath
        Set objParentFolder = objParentFolder.Parent
        strFolder = objParentFolder.Name
    Loop
    ' Loop through the items in the folder. NOTE: This has to

    ' be done backwards; if you process forwards you have to

    ' re-run the macro an inverse exponential number of times.

    For intCount = objSourceFolder.Items.Count To 1 Step -1

        ' Retrieve an object from the folder.

        Set objVariant = objSourceFolder.Items.Item(intCount)

        ' Allow the system to process. (Helps you to cancel the

        ' macro, or continue to use Outlook in the background.)

        DoEvents

        ' Filter objects for emails or meeting requests.

        If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then

            ' This is optional, but it helps me to see in the

            ' debug window where the macro is currently at.

            'Debug.Print objVariant.SentOn & " - " & objVariant.Subject & " - " & DateDiff("d", objVariant.SentOn, Now)

            ' Calculate the difference in years between

            ' this year and the year of the mail object.

            'intDateDiff = DateDiff("yyyy", objVariant.SentOn, Now)
            intDays = DateDiff("d", objVariant.SentOn, Now)
            ' Only process the object if it older than 60 days
            If intDays > 60 Then

                ' Calculate the name of the personal folder.

                strDestFolder = Year(objVariant.SentOn)

                ' Retrieve a folder object for the destination folder.

                'Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("Inbox").Folders(strFolderName)
                Set objDestFolder = objNamespace.(strDestFolder & "\" & strpath)

                ' Move the object to the destination folder.

                objVariant.Move objDestFolder

                ' Just for curiousity, I like to see the number

                ' of items that were moved when the macro completes.

                lngMovedMailItems = lngMovedMailItems + 1

                ' Destroy the destination folder object.

                Set objDestFolder = Nothing

            End If

        End If

    Next


    ' Display the number of items that were moved.

    MsgBox "Moved " & lngMovedMailItems & " messages(s)."


End Sub

 

[jdraw]

Gasman,

I found this article related to Outlook folders/subfolders via Google that may be useful. You might do some experimenting to see if it applicable.

I haven't used outlook for many years, so can't test it.

Good luck. Let us know if you find a solution.

 

[Gasman]

Thank you jdraw,

I have since found out that
objSourceFolder.FolderPath or objSourceFolder.FullFolderPath will give me the same without walking the parent? , at least for my test example.

I'm OK getting the path, I am trying to find out how you specify it, but not having much luck with Google.

I might have to parse the path and then construct the Folders code, though not sure how to build that, so I can execute it?:banghead:

 

[Gasman]

Still have not found out how to address using a path, so using this as a workaround for now. The user has to select where the messages will go.

  Set objDestFolder = objNamespace.PickFolder
    If objDestFolder Is Nothing Then
        MsgBox "No destination folder selected, macro will end"
        GoTo exitsub
    End If

 

[Gasman]

Haven't actaully found out how to use a standard path to navigate the folders, but have been shown the code below.
For anyone in the same position, I received this from the msofficeforums and can adapt it to what I already have.

You can loop through the folders collection below any start folder and move the message to that folder. The following puts the selected message in the named folder ("Folder Name"), creating it as a subfolder of the start folder if not present. The macro prompts for the top level start folder.

Option Explicit

Sub MoveMessage()
Dim olMsg As MailItem
Dim olFolder As Folder
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    GetFolder olMsg, "Folder Name"
lbl_Exit:
    Set olMsg = Nothing
    Exit Sub
End Sub

Sub GetFolder(olItem As MailItem, strFolderName As String)
Dim olNS As NameSpace
Dim cFolders As Collection
Dim olFolder As Outlook.Folder
Dim StartFolder As Outlook.Folder
Dim SubFolder As Outlook.Folder
Dim bExists As Boolean
    Set cFolders = New Collection
    Set olNS = GetNamespace("MAPI")
    Set StartFolder = olNS.PickFolder
    cFolders.Add StartFolder
    Do While cFolders.Count > 0
        Set olFolder = cFolders(1)
        cFolders.Remove 1
        If UCase(olFolder.Name) = UCase(strFolderName) Then
            bExists = True
            Exit Do
        End If
        For Each SubFolder In olFolder.folders
            cFolders.Add SubFolder
        Next SubFolder
    Loop
    If Not bExists Then
        Set olFolder = StartFolder.folders.Add(strFolderName)
    End If
    olItem.Move olFolder
lbl_Exit:
    Set olNS = Nothing
    Set StartFolder = Nothing
    Set cFolders = Nothing
    Set olFolder = Nothing
    Exit Sub
End Sub

 

[Gasman]

Finally cobbled something together that suits my needs at least.
My code (adapted from Google searches)

  Sub MoveOldEmails()
   
      ' Declare all variables.
   
      Dim objOutlook As Outlook.Application
   
      Dim objNamespace As Outlook.NameSpace
   
      Dim objSourceFolder As Outlook.MAPIFolder
   
      Dim objDestFolder As Outlook.MAPIFolder
      Dim objFolders As Outlook.Folders
      Dim objFolder As Outlook.Folder
      
      Dim currentExplorer As Explorer
      Dim Selection As Selection
   
      'Dim objVariant As Variant
      Dim objMsg As MailItem
      Dim lngMovedMailItems As Long
   
      Dim intCount As Integer, intDays As Integer, IntProcessed As Integer, intItemCount As Integer
   
      Dim intDateDiff As Integer
   
      Dim strDestFolder As String
      Dim strSourceFolderName As String, strDestFolderName As String
      Dim blnFolderChecked As Boolean
   
   
      ' Create an object for the Outlook application.
   
      Set objOutlook = Application
   
      ' Retrieve an object for the MAPI namespace.
   
      Set objNamespace = objOutlook.GetNamespace("MAPI")
   
      ' Retrieve a folder object for the source folder and get its name.
   
      Set objSourceFolder = Application.ActiveExplorer.CurrentFolder
      strSourceFolderName = objSourceFolder.Name
      
      ' Loop through the items in the folder. NOTE: This has to
   
      ' be done backwards; if you process forwards you have to
   
      ' re-run the macro an inverse exponential number of times.
   
      ' Set the Progress box
      ProgressBox.Show
      intItemCount = objSourceFolder.Items.Count
      For intCount = objSourceFolder.Items.Count To 1 Step -1
          IntProcessed = IntProcessed + 1
         ' Debug.Print "Percentage is " & Int(IntProcessed / intItemCount * 100)
          ' Retrieve an object from the folder.
   
          Set objMsg = objSourceFolder.Items.Item(intCount)
      
          DoEvents
      
              ' Filter objects for emails or meeting requests.
      
          If objMsg.Class = olMail Or objMsg.Class = olMeetingRequest Then
   
              ' This is optional, but it helps me to see in the
   
              ' debug window where the macro is currently at.
   
              'Debug.Print objMsg.SentOn & " - " & objMsg.Subject & " - " & DateDiff("d", objMsg.SentOn, Now)
   
              ' Calculate the difference in days between now and the date of the mail object.
   
              intDays = DateDiff("d", objMsg.SentOn, Now)
              ' Only process the object if it older than 60 days
              If intDays > 60 Then
   
                  ' Calculate the name of the personal folder, which is the year of the message.
   
                  strDestFolder = Year(objMsg.SentOn)
                  Set objFolder = GetFolderByName(strDestFolder)
                  If objFolder Is Nothing Then
                      Exit For 'Debug.Print objFolder.Name
                  End If
                  ' Retrieve a folder object for the destination folder.
   
                  'Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("Inbox").Folders(strFolderName)
                  ' Create/find folder one time
                  If Not blnFolderChecked Then
                      Set objDestFolder = CreateOutlookFolder(objSourceFolder.Name, objFolder)
                      blnFolderChecked = True
                  End If
                  ' Move the object to the destination folder.
                  
                  objMsg.Move objDestFolder
   
                  ' Just for curiousity, I like to see the number
   
                  ' of items that were moved when the macro completes.
   
                      lngMovedMailItems = lngMovedMailItems + 1
   
                  ' Destroy the destination folder object.
   
                  'Set objDestFolder = Nothing
   
              End If
   
          End If
           ProgressBox.Increment Int(IntProcessed / intItemCount * 100)
      Next
   
   
   
  exitsub:
      ' Display the number of items that were moved.
      MsgBox "Moved " & lngMovedMailItems & " messages(s)."
   
      ProgressBox.Hide
      Set objOutlook = Nothing
      Set objNamespace = Nothing
      Set objSourceFolder = Nothing
      Set objDestFolder = Nothing
      Set objFolders = Nothing
      Set objFolder = Nothing
      Set objMsg = Nothing
  End Sub

and it uses some code supplied by Graham Mayor (http://www.msofficeforums.com/outlook/37648-folder-path-outlook-moving-files.html#post122795) which I turned into a function

  Function CreateOutlookFolder(strFolderName As String, objRootFolder As Folder) As Folder
  Dim olNS As NameSpace
  Dim cFolders As Collection
  Dim olFolder As Outlook.Folder
  Dim StartFolder As Outlook.Folder
  Dim SubFolder As Outlook.Folder
  Dim bExists As Boolean
      Set cFolders = New Collection
      Set olNS = GetNamespace("MAPI")
      'Set StartFolder = olNS.PickFolder
      Set StartFolder = objRootFolder
      cFolders.Add StartFolder
      Do While cFolders.Count > 0
          Set olFolder = cFolders(1)
          cFolders.Remove 1
          If UCase(olFolder.Name) = UCase(strFolderName) Then
              bExists = True
              Exit Do
          End If
          For Each SubFolder In olFolder.Folders
              cFolders.Add SubFolder
          Next SubFolder
      Loop
      If Not bExists Then
          Set olFolder = StartFolder.Folders.Add(strFolderName)
      End If
      Set CreateOutlookFolder = olFolder
  lbl_Exit:
      Set olNS = Nothing
      Set StartFolder = Nothing
      Set cFolders = Nothing
      Set olFolder = Nothing
      Set objRootFolder = Nothing
      
  End Function

and as Outlook does not allow access to the status bar (or at least as far as I could find) a progress form created from http://www.outlookcode.com/codedetail.aspx?id=1077

  [COLOR=#666C86][FONT=&quot]Option[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Explicit[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]' Implements a progress box with a progress bar and space for user-defined text above the bar[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]' Uses Microsoft's Forms library (by default available with all office/VBA installations)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]' To use in your VBA project:[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]' 1) Make sure that the "Microsoft Forms" object library is checked in Tools/References[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]' 2) Insert a blank User Form[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]' 3) Rename the user form to "ProgressBox"[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]' 4) Set the user form property "showModal" to false (so you can do other things while the dialog is displayed)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]' 5) Show the code for the User Form, and highlight/delete everything[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]' 6) Insert this file (using insert/file) into the code for the User Form[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]' 7) Add appropriate code to your VBA routine where you want to show progress:[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]'     * ProgressBox.Show --- shows the progress box. Include this before starting processing.[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]'     * ProgressBox.Increment newPercent (single), NewText (optional string) --- updates the progress bar and optionally changes the text[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]'     * ProgressBox.Hide --- removes the progress bar. Include this at the end of processing.[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]' 8) Optionally, you can get/set the percentage and the text individually using the "Percent" and "Text" properties, followed by calling ProgressBox.repaint[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Const[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]DefaultTitle = "Progress"[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]myText As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]String[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]myPercent As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Single[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]' Text property shows user-defined text above the progress bar[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Public[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Property[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Let[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Text(newText As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]String)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  If[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]newText <> myText Then[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    myText = newText[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Me.Controls("UserText").Caption = myText[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Call[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]sizeToFit[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]If[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Property[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]Public[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Property[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Get[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Text() As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]String[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Text = myText[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Property[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]' Percent property alters the progress bar[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Public[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Property[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Let[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Percent(newPercent As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Single)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  If[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]newPercent <> myPercent Then[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    ' limit percent to between 0 and 100[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    myPercent = Min(Max(newPercent, 0#), 100#)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Call[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]updateProgress[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]If[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Property[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]Public[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Property[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Get[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Percent() As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Single[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Percent = myPercent[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Property[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]' Increment method enables the percent and optionally the text to be updated at same time[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Public[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Increment(ByVal[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]newPercent As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Single, Optional[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]ByVal[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]newText As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]String)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Percent = newPercent[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  If[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]newText <> ""[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Then[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Me.Text = newText[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Call[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]updateTitle[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Repaint[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]' Setup the progress dialog - title, control layout/size etc.[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]UserForm_Initialize()[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Call[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]setupControls[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Call[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]updateTitle[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]' Prevents use of the Close button[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]UserForm_QueryClose(Cancel As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Integer, CloseMode As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Integer)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  If[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]CloseMode = vbFormControlMenu Then[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Cancel = True[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]' Removes any current controls, add the needed controls ...[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]setupControls()[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Dim[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]i As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Integer[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Dim[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]aControl As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Label[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  ' remove existing controls[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  For[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]i = Me.Controls.Count To[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]1 Step[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]-1[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Me.Controls(i).Remove[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Next[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]i[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  ' add user text - don't worry about positioning as "sizeToFit" takes care of this[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Set[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]aControl = Me.Controls.Add("Forms.Label.1", "UserText", True)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.Caption = ""[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.AutoSize = True[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.WordWrap = True[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.Font.Size = 8[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  ' add progressFrame - don't worry about positioning as "sizeToFit" takes care of this[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Set[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]aControl = Me.Controls.Add("Forms.Label.1", "ProgressFrame", True)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.Caption = ""[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.Height = 16[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.SpecialEffect = fmSpecialEffectSunken[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  ' add user text - don't worry about positioning as "sizeToFit" takes care of this[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Set[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]aControl = Me.Controls.Add("Forms.Label.1", "ProgressBar", True)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.Caption = ""[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.Height = 14[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.BackStyle = fmBackStyleOpaque[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  aControl.BackColor = &HFF0000 ' Blue[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  ' position the controls and size the progressBox[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Call[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]sizeToFit[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR]
  
  
  [COLOR=#666C86][FONT=&quot]' Adjusts positioning of controls/size of form depending on size of user text[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]sizeToFit()[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  ' setup width of progress box[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Width = 240[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  ' user-supplied text should be topmost, taking up the appropriate size ...[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("UserText").Top = 6[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("UserText").Left = 6[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("UserText").AutoSize = False[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("UserText").Font.Size = 8[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("UserText").Width = Me.InsideWidth - 12[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("UserText").AutoSize = True[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  ' progress frame/bar should be below user text[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("ProgressFrame").Top = Int(Me.Controls("UserText").Top + Me.Controls("UserText").Height) + 6[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("ProgressFrame").Left = 6[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("ProgressFrame").Width = Me.InsideWidth - 12[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("ProgressBar").Top = Me.Controls("ProgressFrame").Top + 1[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Controls("ProgressBar").Left = Me.Controls("ProgressFrame").Left + 1[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Call[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]updateProgress ' update ProgressBar width[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  ' finally, height of progress box should fit around text and progress bar & allow for title/box frame[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Me.Height = Me.Controls("ProgressFrame").Top + Me.Controls("ProgressFrame").Height + 6 + (Me.Height - Me.InsideHeight)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]' updates the caption of the progress box to keep track of progress[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]updateTitle()[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  If[/FONT][/COLOR][COLOR=#666C86][FONT=&quot](Int(myPercent) Mod[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]5) = 0 Then[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Me.Caption = DefaultTitle & " - "[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]& Format(Int(myPercent), "0") & "% Complete"[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]If[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]' updates the width of the progress bar to match the current percentage[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]updateProgress()[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  If[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]myPercent = 0 Then[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Me.Controls("ProgressBar").Visible = False[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Else[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Me.Controls("ProgressBar").Visible = True[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Me.Controls("ProgressBar").Width = Int((Me.Controls("ProgressFrame").Width - 2) * myPercent / 100)[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]If[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Sub[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]' Min and Max functions[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Function[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Min(number1 As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Single, number2 As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Single) As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Single[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  If[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]number1 < number2 Then[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Min = number1[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Else[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Min = number2[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]If[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Function[/FONT][/COLOR]
  
  [COLOR=#666C86][FONT=&quot]Private[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Function[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Max(number1 As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Single, number2 As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Single) As[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Single[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  If[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]number1 > number2 Then[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Max = number1[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  Else[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]    Max = number2[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]  End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]If[/FONT][/COLOR]
  [COLOR=#666C86][FONT=&quot]End[/FONT][/COLOR][COLOR=#666C86][FONT=&quot]Function[/FONT][/COLOR]

This might help someone else trying to do a similar task?