Selecting folder with msoFileDialogFolderPicker

Discussion in 'Outlook VBA and Custom Forms' started by Izbi, Feb 15, 2017.

Tags:
  1. Izbi

    Izbi

    New Member
    This macro saves selected emails into a folder chosen by function "BrowseForFolder". It also adds the date as part of the filename. My issue is that the default start folder selected is always the same and I have to navigate to the folder each time.
    I want to use "msoFileDialogFolderPicker" to select the folder because this is able to remember the last folder chosen and default to that path as the start when the macro is called again.

    Code (Text):
    Copy Source

    Option Explicit

    Public Sub Save_Messages_Select_Ask2()

    Dim oMail As Outlook.MailItem
    Dim objItem As Object
    Dim sPath As String
    Dim dtDate As Date
    Dim sName As String
    Dim enviro As String

    enviro = CStr(Environ("USERPROFILE"))
    For Each objItem In ActiveExplorer.Selection

    If objItem.MessageClass = "IPM.Note" Then
    Set oMail = objItem

    sName = oMail.Subject

    dtDate = oMail.ReceivedTime
    sName = Format(dtDate, "yyyy mm dd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, " hhnn", _
    vbUseSystemDayOfWeek, vbUseSystem) & " - " & sName & ".msg"

    sPath = BrowseForFolder(enviro & "\Documents\")
    Debug.Print sPath & "\" & sName
    oMail.SaveAs sPath & "\" & sName, olMSG

    End If
    Next

    End Sub

    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
     
     
Loading...

Share This Page