Here is my code:
Public Structure OpenFilename
Dim lStructSize As Integer
Dim hwndOwner As Integer
Dim hInstance As Integer
Dim lpstrFilter As String
Dim lpstrCustomFilter As String
Dim nMaxCustFilter As Integer
Dim nFilterIndex As Integer
Dim lpstrFile As String
Dim nMaxFile As Integer
Dim lpstrFileTitle As String
Dim nMaxFileTitle As Integer
Dim lpstrInitialDir As String
Dim lpstrTitle As String
Dim flags As Integer
Dim nFileOffset As Int16
Dim nFileExtension As Int16
Dim lpstrDefExt As String
Dim lCustData As Integer
Dim lpfnHook As SubclassCallback 'Normally declared as an
integer
Dim lpTemplateName As Integer
Dim pvReserved As Integer
Dim dwReserved As Integer
Dim FlagsEx As Integer
End Structure
Public Delegate Function SubclassCallback(ByVal hWnd As Integer,
ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As
Integer
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias
"GetOpenFileNameA" (ByRef pOpenfilename As OpenFilename) As Integer
Public Declare Function LoadLibrary Lib "kernel32" Alias
"LoadLibraryA" (ByVal lpLibFileName As String) As Integer
Public Function GetOpenFile(ByVal OwnerHWnd As Integer) As String
Dim CommonDialogStruct As OpenFilename
Dim RetVal As Integer
Dim myCallback As SubclassCallback = New
SubclassCallback(AddressOf SaveAsProc)
With CommonDialogStruct
.lStructSize = Len(CommonDialogStruct)
.hwndOwner = OwnerHWnd
.lpfnHook = myCallback
.lpTemplateName = IDD_DIALOG1
.lpstrFilter = Replace(subFilter, "|", Chr(0)) & Chr(0)
.nFilterIndex = 1
.lpstrFile = subFileName & Chr(0) & Space(255 -
Len(subFileName))
.nMaxFile = Len(.lpstrFile) - 1
.lpstrTitle = subTitle
.lpstrInitialDir = subInitialDirectory
.flags = OFN_FILEMUSTEXIST Or OFN_SHOWHELP Or OFN_EXPLORER
Or OFN_ENABLEHOOK Or OFN_ENABLETEMPLATE
.hInstance = LoadLibrary(myAppPath & "DlgRes_VB.dll") 'This
works. It's the file that defines my extra controls. It loads when I don't
try to change the lpfHook from an integer
.FlagsEx = 0
End With
Try
RetVal = GetOpenFileName(CommonDialogStruct) 'Does nothing.
Doesn't even throw an exception
Catch ex As Exception
MsgBox(ex.Message)
End Try
GetOpenFile = ""
If RetVal = 0 Then
GetOpenFile = ""
ElseIf RetVal = 1 Then
GetOpenFile = (Trim(CommonDialogStruct.lpstrFile))
Else
'error
MsgBox(CommDlgExtendedError)
End If
FreeLibrary(CommonDialogStruct.hInstance)
End Function
Public Function SaveAsProc(ByVal hwnd As Integer, ByVal uMsg As
Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Dim NMHStruct As NMHDR
Dim lContext As Integer
Dim lTemp As Integer
Dim lNotificationCode As Integer
Dim lControlID As Integer
Dim hCtrl As Integer
Dim lRetVal As Integer
SaveAsProc = 0
Select Case uMsg
'.....
end Select
end Function
Hope it makes sense!
