Create new folder (on hard drive), and save email to it.

I have found two codes, that do their jobs separately perfectly.
But I would like a method to run them together.

Code One:
This basically creates a folder... This folder is going to be called my 'reference number'.

Sub newfold() 
    Dim strNewFolderName As String 
    strNewFolderName = InputBox("Input Reference Number - For Example 12345") 
    If Len(Dir("c:\" & strNewFolderName, vbDirectory)) = 0 Then 
        MkDir ("c:\" & strNewFolderName) 
    End If 
End Sub

Code Two:
This unmodified code saves my email to a folder.
However, I would like to modify this code, or add 'Code One' to it, so that I can choose where I would like my email to be saved.

Sub OpenAndSave()
    Const SAVE_TO_FOLDER = "C:\eeTesting\"
    Dim olkMsg As Outlook.MailItem, intCount As Integer
    intCount = 1
    For Each olkMsg In Outlook.ActiveExplorer.Selection
        olkMsg.Display
        olkMsg.SaveAs SAVE_TO_FOLDER & "Message #" & intCount & " " & RemoveIllegalCharacters(olkMsg.Subject) & ".msg"
        olkMsg.Close olDiscard
        intCount = intCount + 1
    Next
    Set olkMsg = Nothing
End Sub

Function RemoveIllegalCharacters(strValue As String) As String
    ' Purpose: Remove characters that cannot be in a filename from a string.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    RemoveIllegalCharacters = strValue
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "")
End Function

The end result should be, clicking one button on the toolbar, entering my reference and pressing enter.
Performing that action, I would expect this code (with a little modifying) to create the new folder, and then save my selected email inside that folder.

Is this possible? Can these two codes be merged together to get the desired effect? I would love to get this working, it would save me a lot of hassle.
Thanks

--- Edit ---

My idea was something like this. But obviously doesn't work, because otherwise I wouldn't be posting here lol.

Sub OpenAndSave()
    Dim strNewFolderName As String
        
    strNewFolderName = InputBox("Input Reference Number - For Example 12345")
    If Len(Dir("G:\" & strNewFolderName, vbDirectory)) = 0 Then
        MkDir ("G:\" & strNewFolderName)
    End If
    
    Const SAVE_TO_FOLDER = "G:\" & strNewFolderName
    Dim olkMsg As Outlook.MailItem, intCount As Integer
    intCount = 1
    For Each olkMsg In Outlook.ActiveExplorer.Selection
        olkMsg.Display
        olkMsg.SaveAs SAVE_TO_FOLDER & "Message #" & intCount & " " & RemoveIllegalCharacters(olkMsg.Subject) & ".msg"
        olkMsg.Close olDiscard
        intCount = intCount + 1
    Next
    Set olkMsg = Nothing
End Sub

Function RemoveIllegalCharacters(strValue As String) As String
    ' Purpose: Remove characters that cannot be in a filename from a string.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    RemoveIllegalCharacters = strValue
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "")
End Function

But this gives an error - highlighting the above text.
Compile error: Constant expression required