outlook vba to saveas .msg allowing user to navigate to target folder.

Use the file dialog object.

It is part of the MS Office automation package.
i.e. in the VBA editor go to Tools => References. Check the "Microsoft Office 11.0 Object Library"

Something like this: (you may need to modify to accept your own file conventions etc)

Public Function GetMySaveAsFileName() As String
  Dim fd As FileDialog
 
  Set fd = FileDialog(msoFileDialogSaveAs)
 
  fd.Filters.Clear
  fd.Filters.Add "Excel Files", "*.xls"
  fd.AllowMultiSelect = False
 
  If fd.Show Then
    GetMySaveAsFileName = fd.SelectedItems(0)
  End If
End Sub

Sorry, should have pointed out, this allows initial filename/ folder as requested:

eg.

Sub GetMySaveAsFileName()
  Dim fd As FileDialog
 
  Set fd = FileDialog(msoFileDialogSaveAs)
 
  fd.Filters.Clear
  fd.Filters.Add "Excel Files", "*.xls"
  fd.AllowMultiSelect = False
  fd.InitialFileName = "C:\"
 
  If fd.Show Then
    GetMySaveAsFileName = fd.SelectedItems(0)
  End If
End Sub

That works in excel, but, for some reason that does not work in Outlook.

It gives "object doesn't support this property or method"

Outlook and Excel both point to the same place C:\Program Files\Common Files\Microsoft Shared\OFFICE11\mso.dll


I saw one error like this that was solved by changing it to msoFileDialogFilePicker. But that still gives same error message.

That is almost identical to my own attempt which I added at the the end of my first post. The only difference is you used appWd.FileDialog, and I used appXls.getsaveasfilename.  

It is very annoying to have to open Word (or Excel) in order to get this simple functionality. Plus, it adds a few seconds to the process.

But, annoyance seems standard with Office/Windows development.

I'll leave this question open for a while in hopes that someone can come up with a solution that does not require Word/Excel opening.

Actually, it turns out that it needed to be in Excel anyhow.  I look up the starting folder based upon the e-mail recipient.

Here is most of the code for anyone who is interested.


Thanks for your help.

RBerke

Function GetSaveAsFilenameParts(ToCity_2010 As String, Optional ByVal suggestedPath As String = "c:", _
    Optional suggestedName = "Navigate to desired folder then click save", _
    Optional suggestedTitle = "Desired Folder") As myPart
Dim Slash As Long
Dim Period As Long
Dim slashparent As Long
    Set appXl = Nothing
 If appXl Is Nothing Then
    Set appXl = CreateObject("Excel.application")
    appXl.Workbooks.Open FileName:="\\server02\Root\XXX program files\XXXZzzzFolderNames.xls", ReadOnly:=True
End If
' If appXl Is Nothing Then Set appXl = GetObject("\\server02\Root\XXX program files\XXXZzzzFolderNames.xls")

Dim possible As String
On Error Resume Next
If Right(ToCity_2010, 13) = ".2010@mydomain.com" Then
   
    possible = appXl.Evaluate("=INDEX(C:C,MATCH(""" & Left(ToCity_2010, Len(ToCity_2010) - 13) & """,A:A,FALSE))")
    On Error GoTo 0
    If possible <> "" Then
        suggestedPath = possible
    End If
End If
' Stop
appXl.Visible = True

' ----- get the name and exit if canceled ----
GetSaveAsFilenameParts.fullname = appXl.GetSaveAsFilename(suggestedPath & "\" & suggestedName, Title:="Desired folder for .msg file")
ChDir "c:\"  ' getsaveasfilename places a lock on folder.  This releases it
appXl.Visible = False
If GetSaveAsFilenameParts.fullname = "False" Then Exit Function
GetSaveAsFilenameParts = GetParts(GetSaveAsFilenameParts.fullname)

End Function