Hi,
i've got a macro that saves in a certain folder emails i select. It works pretty well exept for one thing. This macro has been programmed to name the file .eml according to the subject of the email. Therefore when i decide to save a forwarded email the outcome is someting like this: "I: subjectemail.eml"
I would like to remove the chars "I:"
Here is the code:
Option Explicit

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
  Dim ShellApp As Object
  Set ShellApp = CreateObject("Shell.Application"). _
 BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
  
 On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
 On Error GoTo 0
  
 Set ShellApp = Nothing
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
    End Select
 Exit Function
  
Invalid:
 BrowseForFolder = False
End Function

Public Sub SaveMessageAsMsg()
    Dim oMail As Outlook.MailItem
    Dim objItem As Object
    Dim sPath, strFolderpath As String
    Dim sName As String
    Dim enviro As String

    enviro = CStr(Environ("USERPROFILE"))

    strFolderpath = BrowseForFolder("D:\test\mails\")
    sPath = strFolderpath & "\"

    For Each objItem In ActiveExplorer.Selection
        If objItem.MessageClass = "IPM.Note" Then
            Set oMail = objItem
            sName = oMail.Subject
            ReplaceCharsForFileName sName, "-"
            sName = sName & ".msg"
            Debug.Print sPath & sName
            oMail.SaveAs sPath & sName, olMSG
         End If
    Next
End Sub

  
Private Sub ReplaceCharsForFileName(sName As String, _
  sChr 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