My answer is the same as before.

There are lots of examples of that on the Web, you can search for some. One
for VB6 that will also work for VBA code is at
http://www.vbaccelerator.com/home/VB...ct/article.asp

You can use that code to put up a file save dialog and the return value is
where you'd save the attachments. A possible alternative, although very
clunky would be to use automation code to automate Word or Excel and use
their file save dialogs, but that's clunky as I said.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Rob" wrote in message
...
I'm trying to modify a macro that automatically saves every attachment
within
an Outlook folder to a predetermined/defined directory, that is hard coded
into the macro, so that the user get's to choose a destination everytime
it
is run instead of having to edit the macro internally everytime they want
a
different folder used.

The macro I am using is below:

*************************************

Attribute VB_Name = "GetEmailAttachments"
Option Explicit

Sub GetAttachments()
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.
On Error GoTo GetAttachments_err
' Declare variables
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0
' Check Inbox for messages and exit of none found
If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If
' Check each message for attachments
For Each Item In Inbox.Items
' Save any attachments found
For Each Atmt In Item.Attachments

------------- this is the portion I want to
change -------------------------
' This path must exist! Change folder name as necessary.
FileName = "C:\Email Attachments\" & Atmt.FileName
-------------------------------------------------------------------------------

Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item
' Show summary message
If i 0 Then
MsgBox "I found " & i & " attached files." _
& vbCrLf & "I have saved them into the C:\Email Attachments
folder." _
& vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
Else
MsgBox "I didn't find any attached files in your mail.",
vbInformation, "Finished!"
End If
' Clear memory
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
' Handle errors
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
End Sub

*************************************************

Sorry it took so long to reply, I was away for a while.
Thanks for your help.
Rob