Using 32 bit VBA in Excel 2007

[John]

I have just upgraded to Win 7 AND Excel 2007. Some of my old code runs as
expected in 2007, but any code that uses 32 bit API does not behave. A
sample of the code (from J. Walkenbach's book) is provided below. Any quick
advice ?

Thanks, John


'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String)
As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

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

 

[Chip Pearson]

It works for me in Windows 7 Ultimate 64-bit. Specifically what
problem do you find with the code?

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[John]

I made the rash assumption that the 32 bit call was the problem. My project
is generating a sheet of 24 photo thumbnails along with their "name" on a
worksheet. All photos are stored in files grouped in 24. The eventual print
sheet is then placed in a hard copy folder which allows for quick retrieval.
Has worked like a charm for 8-9 years. I "stepped" the code and it appears
to locate the first entry point on the worksheet, but does not insert the
photo. It then stops. The code(s) are listed below:
This code is from J Walks PUP:
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function


' Macro recorded 7/28/00 by John Eppley

Sub DigitalThumbnails()
Msg = "Select a location containing the Photos you want to print."
directory = GetDirectory(Msg)
If directory = "" Then Exit Sub
If Right(directory, 1) <> "\" Then directory = directory & "\"

Application.ScreenUpdating = False
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = directory
.Filename = "*.*"
.SearchSubFolders = False
.Execute
i = 1

Set mydir = Range("j1")
mydir.FormulaR1C1 = directory
'mydir.FormulaR1C1 = Left(mydir, Len(mydir) - 1)
'mydir.FormulaR1C1 = Mid(mydir, Find("\", mydir, 4) + 1, 24)
'CopyFolderName

For x = 3 To 13 Step 2
For y = 1 To 7 Step 2

ActiveSheet.Cells(x, y).Select
ActiveSheet.Pictures.Insert(.FoundFiles(i)).Select
Selection.ShapeRange.Height = ActiveCell.RowHeight
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = Right(.FoundFiles(i), 12)
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = FileDateTime(.FoundFiles(i))
If .FoundFiles(i) = "" Then Exit Sub
i = i + 1
Next
Next

End With
End Sub