Ok fixed it. I replaced the SHBrowseForFolder.bas file from an
example found at http://www.mvps.org/vbnet/index.html?code/comdlg/fileopendlg.htm
I also adapted Randy Birch's code into the code I adapted from
FreeVBCode.com to save the attachments from the select Outlook Folder.
Here's the finished *working* code:
'.bas module
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ?1996-2002 VBnet, Randy Birch, All Rights Reserved.'
' Some pages may also contain other copyrights by the author. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const MAX_PATH = 260
Public Declare Function SHGetPathFromIDList Lib "shell32" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Public Declare Sub CoTaskMemFree Lib "ole32" _
(ByVal pv As Long)
'bas module or form
Option Explicit
Public Function SaveAttachments()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The Browse dialog from within a VB app code provided by '
' Copyright ?1996-2002 VBnet, Randy Birch, All Rights Reserved.'
' Some pages may also contain other copyrights by the author. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The Browse for Outlook folder code has been '
' Adapted & Modified from code originally found at: '
' http://www.freevbcode.com/ShowCode.asp?ID=1154 '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo Err_Manager
Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim pos As Integer
Dim ol As New Outlook.Application
Dim ns As Outlook.NameSpace
Dim olFldr As Outlook.MAPIFolder
Dim olMessage As Object
Dim sPathName As String
Dim n As Integer
Dim i As Integer
Dim PathName As String
Set ns = ol.GetNamespace("MAPI")
'Open the Outlook Select Folder Dialog Box, save the results to
olFldr
Set olFldr = ns.PickFolder
'If user presses cancel on the Outlook Select Folder Dialog
'Then olFldr returns empty
'If olFldr returns empty then exit function
If Len(olFldr) < 0 Then
Resume Exit_Err_Manager
End If
'Fill the BROWSEINFO structure with the
'needed data. To accomodate comments, the
'With/End With sytax has not been used, though
'it should be your 'final' version.
'hwnd of the window that receives messages
'from the call. Can be your application
'or the handle from GetDesktopWindow().
'bi.hOwner = Me.hWnd
'Pointer to the item identifier list specifying
'the location of the "root" folder to browse from.
'If NULL, the desktop folder is used.
bi.pidlRoot = 0&
'message to be displayed in the Browse dialog
bi.lpszTitle = "Select the directory to save your attachments to"
'the type of folder to return.
bi.ulFlags = BIF_RETURNONLYFSDIRS
'show the browse for folders dialog
pidl = SHBrowseForFolder(bi)
'the dialog has closed, so parse & display the
'user's returned folder selection contained in pidl
path = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
pos = InStr(path, Chr$(0))
'*Label1.Caption = Left(path, pos - 1)
sPathName = Left(path, pos - 1) & "\"
End If
For Each olMessage In olFldr.Items
With olMessage.Attachments
i = .Count
If i > 0 Then
For n = 1 To i
.item(n).SaveAsFile sPathName _
& .item(n).FileName
Next n
End If
End With
DoEvents
Next olMessage
SaveAttachments = True
Call CoTaskMemFree(pidl)
'Free up memory!
Call CoTaskMemFree(pidl)
Set ol = Nothing
Set ns = Nothing
Set olFldr = Nothing
Set olMessage = Nothing
Exit_Err_Manager:
Exit Function
Err_Manager:
Select Case Err.Number
Case 91: 'User hit cancel on the outlook browse for folder dialog
box
Resume Exit_Err_Manager
Case Else
MsgBox Err.Description, vbOKOnly + vbCritical, "Error #" &
Err.Number
Resume Exit_Err_Manager
End Select
End Function
Code works when run in VB6, gets error when compiled (Browse for Outlook Folder)