CHAOSinACT
Registered User.
- Local time
- Today, 09:25
- Joined
- Mar 18, 2009
- Messages
- 235
Well...I think it is a PTRSafe Question anyway...
I have a large, complex VBA driven database I develop at work. Its all written by me except a bit of API code I found license free on the net for calling windows open file dialog boxes. Anyway, its suddenly come to my (urgent) attention that its simply not working on all machines.
I've checked the ptrsafe thing months ago and thought it was working fine:
Declare PtrSafe Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
Declare PtrSafe Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
And since it was working on my machine I didn't notice, that on 64bit windows machines running 64 bit office it doesn't work (64bit window with 32 bit office works fine, i had to set up some machines that way for complex MYOB linking reasons). I don't think its the tsGetFileFromUser function, that's served me well forever...any ideas why this won't work on 64 bit machines?
for reference here is the entire module I'm using, including comments of the author for his credit.
I have a large, complex VBA driven database I develop at work. Its all written by me except a bit of API code I found license free on the net for calling windows open file dialog boxes. Anyway, its suddenly come to my (urgent) attention that its simply not working on all machines.
I've checked the ptrsafe thing months ago and thought it was working fine:
Declare PtrSafe Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
Declare PtrSafe Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
And since it was working on my machine I didn't notice, that on 64bit windows machines running 64 bit office it doesn't work (64bit window with 32 bit office works fine, i had to set up some machines that way for complex MYOB linking reasons). I don't think its the tsGetFileFromUser function, that's served me well forever...any ideas why this won't work on 64 bit machines?
for reference here is the entire module I'm using, including comments of the author for his credit.
'.=========================================================================
'.Browse Files Module
'.Copyright 1999 Tribble Software. All rights reserved.
'.Phone : (616) 455-2055
'.E-mail : carltribble@earthlink.net
'.=========================================================================
' DO NOT DELETE THE COMMENTS ABOVE. All other comments in this module
' may be deleted from production code, but lines above must remain.
'--------------------------------------------------------------------------
'.Description : This module calls directly into comdlg32.dll to allow user
'. to select a filename using the Windows Common Dialog. The
'. user may browse for a file, or enter a file name directly.
'.Written By : Carl Tribble
'.Date Created : 04/05/1999 09:56:31 AM
'.Rev. History :
' Comments : Normally, to use the Common Dialog you need to physically
' place the ActiveX control onto a form and then use code
' behind the form to implement its functionality. This
' module allows you to incorporate the functionality of the
' File Open/Save part of the Common Dialog without the
' ActiveX control itself. This module is completely self-
' contained. Simply copy it into your database to use it.
'.-------------------------------------------------------------------------
'.
' ADDITIONAL NOTES:
'
' This module only provides the Open/Save file dialog, not the other
' CommonDialog interfaces (ColorChooser, Help, PrintDialog, etc.)
'
' If you want your user to browse for folder names (paths) you must use
' the module basBrowseFolders instead.
'
' TO STREAMLINE this module for production programs, you should remove:
' 1) Unnecessary comments
' 2) Flag Constants which you do not intend to use.
' 3) The test procedure tsGetFileFromUserTest
'
'--------------------------------------------------------------------------
'
' INSTRUCTIONS:
'
' ( For a working example, open the Debug window )
' ( and enter tsGetFileFromUserTest. )
'
'.All the arguments for the function are optional. You may call it with no
'.arguments whatsoever and simply assign its return value to a variable of
'.the Variant type. For example:
'.
'. varFileName = tsGetFileFromUser()
'.
'.The function will return:
'. the full path and filename selected or entered by the user, or
'. Null if an error occurs or if the user presses Cancel.
'.
'.Optional arguments may include any of the following:
'. rlngFlags : one or more of the tscFN* constants (declared below)
'. Combine multiple constants like this:
'. tscFNHideReadOnly Or tscFNFileMustExist
'. strInitialDir : the directory to display when dialog opens
'. strFilter : a string containing any filters you want to use. Each
'. part must be separated by the vbNullChar. -example below
'. lngFilterIndex: a 1-based index indicating which filter to start with.
'. strDefaultExt : Extension to use if user does not enter one.
'. strFileName : Default File to display in the File Name text box.
'. strDialogTitle: Caption to display in the dialog's title bar.
'. fOpenFile : Boolean-True for the Open dialog, False for Save dialog.
'
' FILTER EXAMPLE: The filter must be a string containing two parts for each
' filter. The first part is the Description, it is what the user will see
' in the Files of Type box, e.g. "Text Files (*.txt)". The second part is
' the actual filter, e.g. "*.txt". Each part and each filter must be
' separated by the vbNullChar. For example, to provide two filters, one for
' *.mdb files, and one for all files, use a statement like this:
'
' strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
'
' Then pass your strFilter variable as the strFilter argument for the call
' to tsGetFileFromUser()
'
'.--------------------------------------------------------------------------
'.
Option Compare Database
Option Explicit
Declare PtrSafe Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
Declare PtrSafe Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Type tsFileName
lStructSize As Long
hWndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000
Public Function tsGetFileFromUser( _
Optional ByRef rlngflags As Long = 0&, _
Optional ByVal strInitialDir As String = "", _
Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
Optional ByVal lngFilterIndex As Long = 1, _
Optional ByVal strDefaultExt As String = "", _
Optional ByVal strFileName As String = "", _
Optional ByVal strDialogTitle As String = "", _
Optional ByVal fOpenFile As Boolean = True) As Variant
On Error GoTo tsGetFileFromUser_Err
Dim tsFN As tsFileName
Dim strFileTitle As String
Dim fResult As Boolean
' Allocate string space for the returned strings.
strFileName = Left(strFileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With tsFN
.lStructSize = Len(tsFN)
.hWndOwner = Application.hWndAccessApp
.strFilter = strFilter
.nFilterIndex = lngFilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = strDialogTitle
.flags = rlngflags
.strDefExt = strDefaultExt
.strInitialDir = strInitialDir
.hInstance = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
.lpfnHook = 0
End With
' Call the function in the windows API
If fOpenFile Then
fResult = ts_apiGetOpenFileName(tsFN)
Else
fResult = ts_apiGetSaveFileName(tsFN)
End If
' If the function call was successful, return the FileName chosen
' by the user. Otherwise return null. Note, the CancelError property
' used by the ActiveX Common Dialog control is not needed. If the
' user presses Cancel, this function will return Null.
If fResult Then
rlngflags = tsFN.flags
tsGetFileFromUser = tsTrimNull(tsFN.strFile)
Else
tsGetFileFromUser = Null
End If
tsGetFileFromUser_End:
On Error GoTo 0
Exit Function
tsGetFileFromUser_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in function basBrowseFiles.tsGetFileFromUser"
Resume tsGetFileFromUser_End
End Function
' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
On Error GoTo tsTrimNull_Err
Dim i As Integer
i = InStr(strItem, vbNullChar)
If i > 0 Then
tsTrimNull = Left(strItem, i - 1)
Else
tsTrimNull = strItem
End If
tsTrimNull_End:
On Error GoTo 0
Exit Function
tsTrimNull_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in function basBrowseFiles.tsTrimNull"
Resume tsTrimNull_End
End Function
'--------------------------------------------------------------------------
' Project : tsDeveloperTools
' Description : An example of how you can call tsGetFileFromUser()
' Calls :
' Accepts :
' Returns :
' Written By : Carl Tribble
' Date Created : 05/04/1999 11:19:41 AM
' Rev. History :
' Comments : This is provided merely as an example to the programmer
' It may be safely deleted from production code.
'--------------------------------------------------------------------------
Public Function tsGetFileFromUserTest() As String
On Error GoTo tsGetFileFromUserTest_Err
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
strFilter = "All Files (*.*)" & vbNullChar & "*.*"
lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
varFileName = tsGetFileFromUser( _
fOpenFile:=True, _
strFilter:=strFilter, _
rlngflags:=lngFlags, _
strDialogTitle:="GetFileFromUser Test (Please choose a file)")
If IsNull(varFileName) Then
Debug.Print "User pressed 'Cancel'."
Else
Debug.Print varFileName
End If
If varFileName <> "" Then
MsgBox "You selected the '" & varFileName & "' file.", vbInformation
'Set tsGetFileFromUserTest = varFileName
End If
tsGetFileFromUserTest_End:
On Error GoTo 0
Exit Function
tsGetFileFromUserTest_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in sub basBrowseFiles.tsGetFileFromUserTest"
Resume tsGetFileFromUserTest_End
End Function
Last edited: