[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1013
  • Last Modified:

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.



0
rberke
Asked:
rberke
  • 3
  • 3
1 Solution
 
ioanePlanning & Analytics ManagerCommented:
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
0
 
ioanePlanning & Analytics ManagerCommented:
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
0
 
rberkeAuthor Commented:
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.
0
Prepare for your VMware VCP6-DCV exam.

Josh Coen and Jason Langer have prepared the latest edition of VCP study guide. Both authors have been working in the IT field for more than a decade, and both hold VMware certifications. This 163-page guide covers all 10 of the exam blueprint sections.

 
ioanePlanning & Analytics ManagerCommented:
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.)
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

0
 
rberkeAuthor Commented:
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.

0
 
rberkeAuthor Commented:
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
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now