Results 1 to 2 of 2

Thread: Create a folder set at a specific time

  1. #1

    Create a folder set at a specific time

    Hi. My VBA skills are pretty basic as I am only recently out of college. I'm trying to create a macro for Outlook that will create some folders for me on the 1st of the month.

    I have a folder called "Completed Projects." Inside that folder is a set of folders corresponding to a month of the year. (Currently they are February through July). Each month, on the first of the month, I have to manually go in and create a new "month" folder and then 4 subfolders inside it, aptly named priority 1, priority 2, priority 3, and priority 4. To make my life a little easier, I built the following code to create the 4 "priority" folders inside the folder I have selected/targeted (by clicking on it):

    Sub CreateFolders()Dim CurrentFolder As Outlook.MAPIFolder
    Dim Subfolder As Outlook.MAPIFolder
    Dim List As New VBA.Collection
    Dim Folders As Outlook.Folders
    Dim Item As Variant
    List.Add Array("Priority 1", olFolderInbox)
    List.Add Array("Priority 2", olFolderInbox)
    List.Add Array("Priority 3", olFolderInbox)
    List.Add Array("Priority 4", olFolderInbox)
    Set CurrentFolder = Application.ActiveExplorer.CurrentFolder
    Set Folders = CurrentFolder.Folders
    For Each Item In List
        Folders.Add Item(0), Item(1)
    End Sub
    I was hoping to get some help with the rest of the code as I am at a loss as to what to do. In short these things are where I am a bit stuck:
    1. I want the code to automatically do this process on the first of the month if possible. Time doesn't necessarily matter, but date does. Having to click to start the macro is fine.
    2. It would be nice if it could identify the current month and create that month's folder (titled the name of the month) in the "Completed Projects" folder
    3. Then it needs to create the four subfolders within that month.
    4. The final folderpath would look like inbox/Completed Projects/Month Name/priority folder 1 - 4

    The company-I-work for's rules automatically delete any email messages that are 6 months or older. If this empties a folder, the folder is deleted. So, there shouldn't be any concern about accidentally creating folders with the same name (ie; there will never be two June's at the same time).

    Can anybody help me finish out my code?

  2. #2
    VBAX Mentor
    Dec 2008
    Try this code:
    Private Sub Application_Startup()
        Dim oFlder As Outlook.Folder
        Dim oSubFolder As Outlook.Folder
        Dim strMonth As String
        Dim boolExists As Boolean
        Dim i As Long
        For Each oFlder In Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders
          If oFlder.Name = "My Completed Projects" Then
            boolExists = True
            Exit For
          End If
        Next oFlder
        If Not boolExists Then
          Set oFlder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders.Add(Name:="My Completed Projects")
        End If
        boolExists = False
        strMonth = Format(Date, "mmmm")
        For Each oSubFolder In oFlder.Folders
          If oSubFolder.Name = strMonth Then
            boolExists = True
            Exit For
          End If
        Next oSubFolder
        If Not boolExists Then
          Set oSubFolder = oFlder.Folders.Add(Name:=strMonth)
          For i = 1 To 4
            oSubFolder.Folders.Add Name:="Priority " & CStr(i)
          Next i
        End If
    End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts