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