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

Outlook's Item.SaveAs path,olMsg requires a fully qualified path.

How can I let the user choose the folder path?

I'll take any solution, but the ideal solution would allow the user to suggest a folder and filename, but allow the vba program to enforce certain file naming conventions.

Something like Excel's GetSaveAsFileName would be ideal the problem.

I thought this would be simple, but a half hour of googling convinced me otherwise.

rberke

P.S. I even tried
set xls = createobject("Excel.Application")
targetname = xls.getsaveasfilename

But, the xls navigation dialog seems to get "buried" under Outlook where noone can see it. I could problably make it pop to the top with various tricks but I think I would end up regretting that.

Also, I found 'BrowseFolder' code at http://www.cpearson.com/excel/browsefolder.aspx
but I really want to have an initalfolder option which that subroutine does not seem to have.

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

Ok, you can use the FileDialog object via other MS Office applications such as Word. See code below.

This will work for locating the folder to save to but not for specifying the name of the file.

To add the "SaveAs" filename you will need to either use an InputBox, create a custom form for user input, or use an automatically generated filename.

(You can use the SaveAs file dialog option but it will only allow suffixes that relate to the application being used i.e. for Word you can only save as .doc, .txt, etc... Knowing this, you can then remove the suffix and replace with your own in code but is a bit messy.)

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:



Function GetSaveToFolderViaWord()
  Dim appWd As Word.Application
  Dim fd As Office.FileDialog
  
  On Error Resume Next
  
  Set appWd = CreateObject("Word.Application")
  Set fd = appWd.FileDialog(msoFileDialogFolderPicker)
  
  appWd.Visible = False
  With fd
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xls"
    .InitialFileName = "C:\"
  End With
  
  If fd.Show Then
    GetSaveToFolderViaWord = fd.SelectedItems(1)
  End If
  appWd.Quit
End Function

Open in New Window

Select All