PDA

View Full Version : Solved: API Call not working


malik641
12-08-2005, 05:53 PM
This is code from John Walkenbach's book "Excel 2000 Power Programming with VBA":

Option Explicit
'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

Function GetDirectory(Optional msg) As String
On Error Resume Next
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 = "Please select the folder where 'Old Bio-Analytical MS.xls' exists."
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$(10))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

Sub GetAFolder()
Dim msg As String
msg = "Please select a location for the backup."
Debug.Print GetDirectory(msg)
End Sub

The Sub at the bottom is just a test for the call...which isn't working http://www.vbforums.com/images/smilies/frown.gif



I get the error where the red text is. Apparently variable pos = 0 http://www.vbforums.com/images/smilies/confused.gif

Any ideas????
Bob Phillips
12-08-2005, 06:04 PM
Option Explicit
'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

Function GetDirectory(Optional msg) As String
On Error Resume Next
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 = "Please select the folder where 'Old Bio-Analytical MS.xls' exists."
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

Sub GetAFolder()
Dim msg As String
msg = "Please select a location for the backup."
Debug.Print GetDirectory(msg)
End Sub
lucas
12-08-2005, 06:05 PM
Hi Joseph,
I don't get an error when I run the GetAFolder sub....I get a Browse for folder dialog with the heading from the sub..Please select a location for the backup.

I get Please select the folder where 'Old Bio-Analytical MS.xls' exists. if I just run the function...
malik641
12-08-2005, 06:45 PM
Hi Joseph,
I don't get an error when I run the GetAFolder sub....I get a Browse for folder dialog with the heading from the sub..Please select a location for the backup.

I get Please select the folder where 'Old Bio-Analytical MS.xls' exists. if I just run the function...
Try selecting a folder and press OK. You should get the error there.


XLD...or Bob (whatever you prefer), I tried everything from 1 to 255 (through a loop, of course) for that character. Didn't know there was a zero :eek:

Thanks a lot :thumb

And by the way, what does that zero stand for/represent??
lucas
12-08-2005, 08:39 PM
Try selecting a folder and press OK. You should get the error there.


Joseph,
No error when selecting a folder and clicking on OK.....sub or function and thats with:
pos = InStr(path, Chr$(10))
malik641
12-08-2005, 10:28 PM
OOPS! Sorry Steve. Take out the:

"On Error Resume Next" line (I was doing some testing with that).

THEN you'll get the error I'm talking about. (....:think: )
Bob Phillips
12-09-2005, 08:27 AM
Try selecting a folder and press OK. You should get the error there.


XLD...or Bob (whatever you prefer), I tried everything from 1 to 255 (through a loop, of course) for that character. Didn't know there was a zero :eek:

Thanks a lot :thumb

And by the way, what does that zero stand for/represent??

Windows stores strings will a null to flag the end of the string. Char(0) is that null.

And Bob is good.
malik641
12-09-2005, 09:23 AM
I see. Thanks for the info Bob :thumb


Solved!