How do I change the default Save Location in this code

[Guest]

Here is the code below. This saves animated gifs from Outlook. Currently it
saves it to the desktop. How do I change it from saving to the desktop to My
Pictures?

Sub SaveAttachment()
Dim objCurrentItem As Outlook.MailItem
Dim colAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment

Set objCurrentItem = Application.ActiveInspector.CurrentItem
Set colAttachments = objCurrentItem.Attachments
Set strFolderpath = CreateObject("WScript.Shell")

For Each objAttachment In colAttachments
objAttachment.SaveAsFile (strFolderpath.SpecialFolders("Desktop") & "\" &
objAttachment.FileName)
Next

Set objAttachment = Nothing
Set colAttachments = Nothing
objCurrentItem.Close (olDiscard)
Set objCurrentItem = Nothing

End Sub

 

[Guest]

You may be a little shocked as to the effort to make this happen. See the
code below. Make sure you register the ITMalloc.tlb componenet, which you
can get from here (along with more sample code):

SAMPLE: SFOLDER.EXE Gets the Path of a Special Folder:
http://support.microsoft.com/kb/q191198/

Private Declare Function SHGetMalloc Lib "shell32" (lpMalloc As ITMalloc) As
Long
' This function is used to free the memory allocated by the
SHGetSpecialFolderLocation
' and the SHGetPathFromIDList functions. This function requires a pointer to
the
' Free method of the IMalloc operating system object. To expose this method to
' Visual Basic, you need a reference to the ITMalloc.tlb type library

Private Declare Function SHGetSpecialFolderLocation Lib "shell32" _
(ByVal hwnd As Long, _
ByVal nFolder As Long, _
pidl As Long) As Long
' This function retrieves the PIDL of a special folder. This function
returns NOERROR
' if successful, or an OLE-defined error result otherwise. The function
requires the
' following parameters:
'
' hwnd- long handle to the owner window the client should specify if it
displays a
' dialog box or message box. Use zero for this value
' nFolder- long constant that specifies the special folder. The constant
values are
' the index numbers of the Special folders combo box.
' Pidl- a pointer to the pointer of the special folder.

Private Declare Function SHGetPathFromIDList Lib "shell32" _
(pidl As Long, _
ByVal FolderPath As String) As Long
' This function converts an item identifier list to a file system path. The
function
' returns TRUE if successful, or FALSE otherwise. The function requires the
following
' parameters:
'
' Pidl- a pointer to the pointer of the special folder
' FolderPath- a string buffer to receive the file system path. This
buffer contains
' the directory path.

Public Const CSIDL_MYPICTURES As Long = &H27

Function GetMyPicturesFolder() As String
On Error Resume Next

Dim hResult As Long
Dim bResult As Long
Dim pidl As Long
Dim ShellMalloc As ITMalloc
Dim FolderPath As String * 300
Dim strX As String

'hResult = SHGetSpecialFolderLocation(0, 39, pidl)
hResult = SHGetSpecialFolderLocation(0, CSIDL_MYPICTURES, pidl)

If hResult = 0 Then
'SHGetPathFromIDList only works with special folders that exist on a
hard drive
'For example, "CSIDL_DRIVES" means "My Computer" which is not a
folder on any drive
'Windows NT has a different set of special folders than Windows 95
bResult = SHGetPathFromIDList(ByVal pidl, FolderPath)

hResult = SHGetMalloc(ShellMalloc)
ShellMalloc.Free pidl
Set ShellMalloc = Nothing
strX = Replace(FolderPath, Chr$(30), "")
GetMyPicturesFolder = strX
End If
End Function

 

[Guest]

Only in a perfect world would everybody have their My Documents folder
underneath My Documents. Some utilities like Tweak UI allow you to change
the default location; in cases like this, you have to rely on on the Win32
API to tell you exactly where it is.

--
Eric Legault (Outlook MVP, MCDBA, MCTS: Messaging & Collaboration)
Try Picture Attachments Wizard for Outlook:
http://www.collaborativeinnovations.ca
Blog: http://blogs.officezealot.com/legault/