Ja das geht auch, aber Du musst dich bei Outlook durch die ganze Ordnerstruktur klicken. Man kann hier nicht, wie bei dem Dialog in Excel, schon mal einen bestimmten Pfad vorgeben und dann weiter auswaehlen. Dazu muesste man den Umweg ueber Excel machen. Aber ich glaube, das wird zu kompliziert fur dich. 

Hier mal der gesamte Code fuer nur Outlook. Probier mal, ob das Ok fuer dich ist.

Option Explicit

Sub SaveEmail()

Dim strPath As String
Dim strText As String
Dim obj As Object, objInspector As Object

strPath = BrowseForFolder & "\"

    If TypeOf Application.ActiveWindow Is Outlook.Explorer Then
        Set obj = Application.ActiveWindow
        Set obj = obj.Selection(1)
  
    Else
    
        Set objInspector = ActiveInspector
        objInspector.Activate

        If objInspector.IsWordMail Then
            Set obj = Application.ActiveInspector.CurrentItem
        End If
    End If
    
With obj
    strText = Replace(.Subject, "/", "_")
    strText = Replace(strText, "!", "")
    strText = Replace(strText, ".", "_")
    strText = Replace(strText, "\", "_")
    strText = Replace(strText, ":", "_")
    strText = Replace(strText, "(", "")
    strText = Replace(strText, ")", "")
    strText = Replace(strText, """", "")
    
    
    .SaveAs strPath & Format(.ReceivedTime, "YYYY-MM-DD hh.mm") & " " & strText & ".msg", olMSG
End With

End Sub

Function BrowseForFolder(Optional OpenAt As String) As String

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

Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
    If Left(BrowseForFolder, 1) = ":" Then
        BrowseForFolder = ""
    End If
Case Is = "\"
    If Not Left(BrowseForFolder, 1) = "\" Then
        BrowseForFolder = ""
    End If
Case Else
    BrowseForFolder = ""
End Select

ExitFunction:

Set ShellApp = Nothing

End Function