Creating a new draft folder on Outlook using Excel VBA

This code makes an email from a template I made and information from an Excel table (the MailtTo and subject lines of an email).

It saves to the draft folder in Outlook to be sent later.

How do I create a new folder called 'Reclass' in Outlook that still is in the draft category where those emails will go?

Option Explicit
'Enumeration is by definition the action of establishing the number of something
'I Enumerated my Worksheet Columns to give them a meaningful name
'  that is easy to recognize so if the amount is ever moved

Public Enum EmailColumn
    ecEmailAdresses = 17
    ecSubject = 43
End Enum

Public Sub SaveEmails()

    Dim ReCol As Range                           'Relcass Column Range

    'For Eeach: picking up the reclass section on the OP Report as a renage
    For Each ReCol In Worksheets("Report").Range("AP1:AP1047900")

        'If:Running through Reclass column for only Y respones
        If ReCol = "Y" Then

            'The With Statement allows the user to
            ' "Perform a series of statements on a specified object without
            ' specifying the name of the object multiple times"
            '.Cells(.Row.Count, ecEmailAdresses).End(xlUp).Row actually refers to
            ' ThisWorkbook.Worksheets("Data insert").Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row

            With ThisWorkbook.Worksheets("Report")

                '.Cells(.Rows.Count, ecEmailAdresses): References the last cell in column 43 of the worsheet
                '.End(xlUp): Changes the reference from the last cell to the first used cell above the last cell in column 44
                '.Cells(.Rows.Count, ecEmailAdressess).End(xlUp).Row: returns the Row number of the last cell column 44
                getTemplate(MailTo:=.Cells(ReCol.Row, ecEmailAdresses), Subject:=.Cells(ReCol.Row, ecSubject)).Save

            End With

        End If

    Next

End Sub

Public Function getTemplate(MailTo As String, Optional CC As String, Optional BC As String, Optional Subject As String) As Object
    Const TEMPLATE_PATH As String = "C:\Users\JohnDoe\Documents\Project\Email Template.oft"

    Dim OutApp As Object
    Dim OutMail As Object

    'CreateObject("Outlook.Application"): Creates an instance of an Outlook Application.
    'Outlook.Application.CreatItemFromTemplate returns a new MailItem Based on a saved email Template
    Set OutMail = CreateObject("Outlook.Application").CreateItemFromTemplate(TEMPLATE_PATH)

    With OutMail
        .To = MailTo
        .CC = CC
        .BCC = BC
        .Subject = Subject
    End With

    'Returns the new MailItem to the caller of the function
    Set getTemplate = OutMail

End Function

Solution

First of all, you need to check whether a target folder exists. The GetDefaultFolder methods returns a Folder object that represents the default folder of the requested type for the current profile; for example, obtains the default Calendar folder for the user who is currently logged on.

Sub ChangeCurrentFolder() 
  Dim myNamespace As Outlook.NameSpace 
  Set myNamespace = Application.GetNamespace("MAPI") 
  Set Application.ActiveExplorer.CurrentFolder = _ myNamespace.GetDefaultFolder(olFolderDrafts) 
End Sub

Use the Folders property to get a collection of subfolder. The Folders.Add method creates a new folder in the Folders collection.

Sub AddContactsFolder() 
  Dim myNameSpace As Outlook.NameSpace 
  Dim myFolder As Outlook.Folder 
  Dim myNewFolder As Outlook.Folder 

  Set myNameSpace = Application.GetNamespace("MAPI") 
  Set myFolder = myNameSpace.GetDefaultFolder(olFolderDrafts) 
  Set myNewFolder = myFolder.Folders.Add("My subfolder") 
End Sub

To get a new mail item saved to the specific folder you need to use the Move method like the following sample code shows:

Imports System.Runtime.InteropServices
' ...
Private Sub CreateItemBasedOnTemplate(Application As Outlook.Application)
  Dim ns As Outlook.NameSpace = Nothing
  Dim containerFolder As Outlook.MAPIFolder = Nothing
  Dim item As Outlook.MailItem = Nothing
  Dim movedItem As Outlook.MailItem = Nothing
  Try
    ns = Application.GetNamespace("MAPI")
    containerFolder = ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
    item = Application.CreateItemFromTemplate("D:\MyTemplate.oft", containerFolder)
    ' the item was created in the Drafts folder regardless
    ' that is why we move it to the Inbox folder
    movedItem = item.Move(containerFolder)
    movedItem.Save()
    movedItem.Display()
  Catch ex As COMException
    If (ex.ErrorCode = -2147287038) Then
       System.Windows.Forms.MessageBox.Show(ex.Message,
           "Can't find the template...")
    Else
       System.Windows.Forms.MessageBox.Show(ex.Message,
           "An error was occurred when creating a new item from template...")
    End If
  Finally
    If Not IsNothing(movedItem) Then Marshal.ReleaseComObject(movedItem)
    If Not IsNothing(item) Then Marshal.ReleaseComObject(item)
    If Not IsNothing(containerFolder) Then Marshal.ReleaseComObject(containerFolder)
    If Not IsNothing(ns) Then Marshal.ReleaseComObject(ns)
  End Try
End Sub

You may find the How To: Create a new Outlook message based on a template article helpful.