File Selected email to folder defined by drop down list in combo box

[ahume12]

I would like to create a macro in Outlook VBA that does the following
- Take the existing selected email in a folder in my inbox (note - selected email, not an email that is open in the current inspector)
- Save a copy of this email in .eml format to a local folder in my C drive.
- This folder path should be defined by a project reference list in a userform
- The project reference will be for example PR001/PR002/PR003
- The paths will be for example eg. C:\Users\username\Documents\Folder PR001 Internal Correspondence\
- The email will be saved with the date added to the subject in reverse date format - yyyy-mm-dd-Email-Subject
- The email will have all unsuitable characters removed from the subject prior to saving.

I have experience of creating the userform OK with the dropdowns, and I have some code to replace the unsuitable character, but I cannot find a way to invoke the saveas function and use the filepath associated with the reference defined in the userform.

I have followed the procedure in the following link which has the rough format I am looking for, including the unsuitable character replacement, however this code executes on the sending of an email, which is not what I am looking for.
Save Selected Email Message as .msg File (slipstick.com) (https://www.slipstick.com/developer/code-samples/save-selected-message-file/)

Would appreciate any help
Many thanks
Al

[ahume12]

All

I have had a good go at this over the last couple of days and have managed to get the following code to sort of work.
It works sometimes, which leads me to believe that the special characters replacement I have written in is not working or being invoked correctly after the code for the userform is called.
Here is my code for the Macro

Option ExplicitPublic Sub SaveMessageAsMsgInProjectFile()
Dim oMail As Outlook.MailItem
Dim lstNum As Long
Dim objItem As Object
Dim objApp As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim sSubject As String
Dim strFolderpath As String


Set objItem = ActiveExplorer.Selection.Item(1)



Set oMail = objItem
UserForm3.Show


Debug.Print lstNum
Select Case lstNum
Case -1
' -1 is what you want to use if nothing is selected
sPath = "C:\Users\ahume\Personal\Emails"
Case 0
sPath = "C:\Users\ahume\C1090\2_Ext_Emails\"
Case 1
sPath = "C:\Users\ahume\C1091\2_Ext_Emails\"
Case 2
sPath = "C:\Users\ahume\C1092\2_Ext_Emails\"
Case 3
sPath = "C:\Users\C1093\2_Ext_Emails\"



End Select



sName = oMail.Subject
ReplaceCharsForFileName sName, "-"
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG
End Sub


Public Sub ReplaceCharsForFileName(sSubject As String, _
sChr As String _
)
Dim sName As String
sName = Replace(sName, "'", sChr)
sName = Replace(sName, "*", sChr)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub




The code for the dropdown list is as follows - but I think this is working OK




Private Sub ComboBox1_Change()


End Sub


Private Sub UserForm_Initialize()
With ComboBox1
.AddItem "C1090"
.AddItem "C1091"
.AddItem "C1092"
.AddItem "C1093"


End With
End Sub


Private Sub CommandButton1_Click()
lstNo = ComboBox1.ListIndex
Unload Me
End Sub





I have built various bits of the code from my original message into this macro, but I am still unable to get it to work consistently.

Would appreciate any help