Hi holley,
You can give the below a try:
Sub SaveMSGs()
Dim olFolder As Folder
Dim olItem As MailItem
Dim iCount As Integer
Dim aPath As String, sPath As String
Dim fdObj As Object
aPath = "C:\Users\jbloggs\Desktop\test\" '<<< Change to suit
sPath = apth & Replace(Date, "/", ".") & "\"
Set fdObj = CreateObject("Scripting.FileSystemObject")
If Not fdObj.FolderExists(sPath) Then
fdObj.CreateFolder (sPath)
End If
Set olFolder = Session.PickFolder
For iCount = 1 To olFolder.Items.Count
Set olItem = olFolder.Items(iCount)
If olItem.Class = OlObjectClass.olMail Then
olItem.SaveAs sPath & ValidName(olItem.Subject) & ".msg"
End If
Next iCount
Set olItem = Nothing
Set olFolder = Nothing
MsgBox "Complete"
End Sub
Private Function ValidName(Arg As String) As String
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Pattern = "[\\/:\*\?""<>\|]"
.Global = True
ValidName = .Replace(Arg, "")
End With
End Function