Macro not working windows x64

[Jimmy Chen]

Hi there this VBA code works with Outlok 2007 and Windows 7 + XP 32bit. I have just upgraded a PC to win7 x64 and it's not working I receive a "compile error" User-defined type not defined when I try to compile. It's a outlook 32-bit install on Win7x64. I'm not a programmer so I can't figure it out, I've attached the original code below.

Thanks in advance.


Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260


Function BrowseFolder(Optional Caption As String, _
Optional InitialFolder As String) As String

Dim SH As Shell32.Shell
Dim F As Shell32.Folder
Dim WshShell As Object

Set SH = New Shell32.Shell
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
Set WshShell = CreateObject("WScript.Shell")

If Not F Is Nothing Then
'Special folders don't always return their full path that is why we check the title first
Select Case F.Title
Case "Desktop"
BrowseFolder = WshShell.SpecialFolders("Desktop")
Case "My Documents"
BrowseFolder = WshShell.SpecialFolders("MyDocuments")
Case "My Computer"
MsgBox "Invalid selection", vbCritical + vbOKOnly, "Error"
Exit Function
Case "My Network Places"
MsgBox "Invalid selection", vbCritical + vbOKOnly, "Error"
Exit Function
Case Else
BrowseFolder = F.Items.Item.Path
End Select
End If

'Cleanup
Set SH = Nothing
Set F = Nothing
Set WshShell = Nothing

End Function

Sub SaveAttachment()

'Get all selected items
Set MyOlApplication = CreateObject("Outlook.Application")
Set MyOlNameSpace = MyOlApplication.GetNamespace("MAPI")
Set MyOlSelection = MyOlApplication.ActiveExplorer.Selection

'Make sure at least one item is selected
If MyOlSelection.Count = 0 Then
Response = MsgBox("Please select an item first", vbExclamation, MyApplName)
Exit Sub
End If

'Make sure only one item is selected
If MyOlSelection.Count > 1 Then
Response = MsgBox("Please select only one item", vbExclamation, MyApplName)
Exit Sub
End If

'Retrieve the selected item
Set MySelectedItem = MyOlSelection.Item(1)

'Retrieve all attachments from the selected item
Dim colAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment
Set colAttachments = MySelectedItem.Attachments

'Here makes the user the folder selection
Dim FolderPath As String
FolderPath = BrowseFolder("Select a folder")
If FolderPath = "" Then
Response = MsgBox("Please select a folder. No items were saved", vbExclamation, MyApplName)
Exit Sub
End If

'Save all attachments to the selected location with a date and time stamp of message to generate a unique name
Dim DateStamp As String
Dim MyFile As String
For Each objAttachment In colAttachments
MyFile = objAttachment.FileName
DateStamp = Format(MySelectedItem.CreationTime, " - yyyymmdd_hhnnss")
intPos = InStrRev(MyFile, ".")
If intPos > 0 Then
MyFile = Left(MyFile, intPos - 1) & DateStamp & Mid(MyFile, intPos)
Else
MyFile = MyFile & "DateStamp"
End If

objAttachment.SaveAsFile (FolderPath & "\" & MyFile)
Next

'Cleanup
Set objAttachment = Nothing
Set colAttachments = Nothing
Set MyOlApplication = Nothing
Set MyOlNameSpace = Nothing
Set MyOlSelection = Nothing
Set MySelectedItem = Nothing

End Sub

[jor...@algiz.co.uk]

Hi
I got same problem
Did anyone found solution?