When you use a VBA macro to save messages or files you can hard code the file path, use the user account's My Documents folder, or select a folder on the hard drive. The first two methods are fairly short and sweet.

Note: this function will work in any Office application, it is not specific to Outlook. (Actually, it's not specific to Office either, it's a general VB function.)

Dim strFolderpath  as String
strFolderpath = "C:\OLAttachments\"

Or use this to save to a folder using the user's profile in the path (example, C:\Users\Diane\)

Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
strFolderpath = enviro & "\OLAttachments\"

For more examples, see Using Windows environment variables in Outlook macros

If you want to bring up a folder picker dialog, you need to use a function, such as the one below.

Add the function to your project and call the folderpath using the following format. You can use any valid file path, either a drive letter or network path (\\). If the path is not valid, the folder picker will show all folders (desktop level), as seen in the screenshot.

strFolderpath = BrowseForFolder("C:\Users\username\documents\")

Use this to save the file:
strFile = strFolderpath & "\" & strFile

(The lines above can be used in Save Attachments to the hard drive)

BrowseForFolder Function

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

Save attachments macro using BrowseForFolder

This macro uses BrowseForFolder function when saving email attachments on the selected message. When you use this function, you can browse to or create subfolders but cannot "browse up" to a folder above the preselected root.

Public Sub SaveAttachmentstoFolder()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim i As Long
Dim lngCount As Long
Dim StrFile As String
Dim strPath As String
Dim StrFolderPath As String
Dim strDeletedFiles As String
Dim sFileType As String
    
On Error Resume Next

Set objOL = CreateObject("Outlook.Application")
Set objMsg = objOL.ActiveExplorer.Selection.Item(1)
 
' Get the BrowseForFolder function http://slipstick.me/u1a2d   
StrFolderPath = BrowseForFolder("D:\My Stuff\Email Attachments\")
 
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
         
    If lngCount > 0 Then
     
    For i = lngCount To 1 Step -1
     
    StrFile = objAttachments.Item(i).FileName
    StrFile = StrFolderPath & "\" & StrFile
    objAttachments.Item(i).SaveAsFile StrFile
    
    Next i
    End If
          
ExitSub:
 
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

To make this macro portable when you use a folder under the user's directory, replace StrFolderPath = BrowseForFolder("D:\My Stuff\Email Attachments\") with the following:

Dim StrUserPath as Variant
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))

StrUserPath = enviro & "\Documents\Email Attachments\"
StrFolderPath = BrowseForFolder(StrUserPath)