CommonDialog 13

[indiana1]

My customer wants to convert Access 2000 module to Access 97. (mmm.. silly job).
Anyway, I am stucked in here.
cmdlg32.ocx is loaded. And used to following code.

Dim cdl As MSComDlg.CommonDialog
Set cdl = New MSComDlg.CommonDialog

-> "Active X component can't create object" error message.

Please help me. I am stucked with this simple looking problem.

 

[GKProgrammer]

I would suggest not using the Common Dialog control but instead use the GetOpenFileName function. If you would prefer this I could paste the code for your reference, let me know.

Regards,
gkprogrammer

 

[indiana1]

Yes please.
It would be great with the example code.

Thank you.

 

[GKProgrammer]

OK here it is:

*************BEGIN CODE***************************

Option Compare Database
Option Explicit

'declare library
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long


Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long 'create class type to call file open dialog box
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type


Private mvarDialogTitle As String
Private mvarFileName As String
Private mvarFileTitle As String
Private mvarInitDir As String
Private mvarMaxFileSize As Integer
Private mvarhWnd As Long
Public Property Let hwnd(ByVal vData As Long)
' The owner of the window
mvarhWnd = vData
End Property

Public Property Get hwnd() As Long
hwnd = mvarhWnd
End Property

Public Function ShowOpen(Title As String) As String
Dim Extension As String, Name As String, StrPath As String
Dim OFN As OPENFILENAME
Dim Result
Dim retval As Long
Dim FileTitle As String
Dim intNullChr As Integer
On Error GoTo ErrHandler
Class_Initialize (Title) 'initialize class with title passed
With OFN
.hwndOwner = hwnd
.hInstance = 0
.lCustData = 0
.lpfnHook = 0
.lpstrFile = FileName & String$(MaxFileSize - Len(FileName) + 1, 0)
.lpstrFileTitle = FileTitle & Space$(256) 'set values for class object
.lpstrInitialDir = InitDir
.lpstrTitle = DialogTitle
.lStructSize = Len(OFN)
.nMaxFile = MaxFileSize
.nMaxFileTitle = 260
End With

retval = GetOpenFileName(OFN) 'open dialog box for user to select file

If retval > 0 Then
With OFN
StrPath = Left$(Trim$(.lpstrFile), .nFileOffset)
Name = Left$(Trim$(.lpstrFileTitle), Len(Trim$(.lpstrFileTitle)) - 1) 'get path,name and extension of file
Extension = Right$(Name, 3)
ShowOpen = StrPath & Name 'set to path and file name
End With
Else
ShowOpen = "Cancelled"
End If

Exit Function

ErrHandler:
Resume Next
End Function

Public Property Let MaxFileSize(ByVal vData As Integer)
' The maximum length of file name returned
mvarMaxFileSize = vData
End Property

Public Property Get MaxFileSize() As Integer
MaxFileSize = mvarMaxFileSize
End Property

Public Property Let InitDir(ByVal vData As String)
' Directory to open window in
mvarInitDir = vData
End Property

Public Property Get InitDir() As String
InitDir = mvarInitDir
End Property

Public Property Let FileTitle(ByVal vData As String)
' The name of the file without path
mvarFileTitle = vData
End Property

Public Property Get FileTitle() As String
FileTitle = mvarFileTitle
End Property

Public Property Let FileName(ByVal vData As String)
' Name of the file, including path
mvarFileName = vData
End Property

Public Property Get FileName() As String
FileName = mvarFileName
End Property

Public Property Let DialogTitle(ByVal vData As String)
' The name of the dialog box
mvarDialogTitle = vData
End Property

Public Property Get DialogTitle() As String
DialogTitle = mvarDialogTitle
End Property
Private Sub Class_Initialize(Title As String)
DialogTitle = Title
FileName = " "
FileTitle = " " 'set original values for class
InitDir = "C:\"
MaxFileSize = 260
hwnd = Screen.Application.hWndAccessApp
End Sub

****************end code*********************


Call the function ShowOpen with the title of the dialog box and it will return the path of the file selected. Regards,
gkprogrammer

 

[RLB2]

Thanks for the Open Filename routine. I tried it out on A2K and it works great! Do you have code for saving a file also? I would appreciate it! I just need to point to the save path, not actually saving a file.

Thanks!

Rob

 

[GKProgrammer]

Hi Rob,

I think this would do it for you:

************BEGIN CODE**********************

Type shellBrowseInfo
hWndOwner As Long
pIDlRoot As Long
pszDisplayName As Long
IpszTitle As String
uIFlags As Long
IpfnCallBack As Long
IParam As Long
iImage As Long
End Type

Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260

Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Declare Function SHBrowseForFolder Lib "shell32" (Ipbi As shellBrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal IpBuffer As String) As Long

Sub main()
Dim temphwnd As Long
Dim Title As String
Dim FilePath As String

temphwnd = Screen.Application.hWndAccessApp
Title = "Find path to Save file to" 'Title for dialog box
FilePath = GetFolder(Title, temphwnd)'Equals Empty if cancel is selected


End Sub

Public Function GetFolder(dlgTitle As String, Frmhwnd As Long) As String

Dim intNullChr As Integer
Dim IngIDlist As Long
Dim IngResult As Long
Dim strFolder As String
Dim BI As shellBrowseInfo


With BI
.hWndOwner = Frmhwnd
.IpszTitle = dlgTitle
.uIFlags = BIF_RETURNONLYFSDIRS
End With

IngIDlist = SHBrowseForFolder(BI)
If IngIDlist <> 0 Then
strFolder = String$(MAX_PATH, 0)
IngResult = SHGetPathFromIDList(IngIDlist, strFolder)
Call CoTaskMemFree(IngIDlist) 'frees the ole pointer to InglDlist
intNullChr = InStr(strFolder, vbNullChar)
If intNullChr Then
strFolder = Left$(strFolder, intNullChr - 1)
End If
Else
GetFolder = &quot;Empty&quot;
Exit Function
End If

GetFolder = strFolder


End Function

*********************END CODE*********************

Let me know if this helps. Regards,
gkprogrammer

 

[jancheta]

gkprogrammer,
Thanks for this post. I've been struggling with Access XP trying to get the FileDialog box (problems with closing it after .show, also trying it to do a SaveAs) but was unsuccessful. Gosh it would seem that this should be easy since Access 2000 has the Common Dialog box control!!!. I tried code posted by others for GetOpenFileName but didn't work either until I found your post and it works PERFECTLY!

Thanks again!

jason

 

[GKProgrammer]

Hi Jason,

Not a problem, happy I could help. Regards,
gkprogrammer

 

[hysaccess]

Sorry, bout this but how do u do it in access 2000

 

[hwkranger]

This is UBER

Randall Vollen
National City Bank Corp.

 

[GKProgrammer]

UBER????

Regards,
gkprogrammer

 

[RLB2]

GKProgrammer,

Thanks for the great post I reused it again (Had to dig to this poost to find it). I didn't give you a star last time so here goes! Thanks! Rob