Help need in setting up Call to Open/Save dialog box

[tony007]

Hi every body . I found this code that supposed to allow me browse for .mdb file and select it. But unfortunely i could not set it up. could an expert help me set this up in access 2000. Furthermore how i can refrence the loade .mdb file when ever i want to use it instead of current db in vba.Thanks

***************** Code Start **************
'This code was originally written by Ken Getz.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
' Code courtesy of:
' Microsoft Access 95 How-To
' Ken Getz and Paul Litwin
' Waite Group Press, 1996

Type tagOPENFILENAME
    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

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Function TestIt()
    Dim strFilter As String
    Dim lngFlags As Long
    strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
                    "*.MDA;*.MDB")
    strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
    strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
    strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
    MsgBox "You selected: " & ahtCommonFileOpenSave(InitialDir:="C:\", _
        Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
        DialogTitle:="Hello! Open Me!")
    ' Since you passed in a variable for lngFlags,
    ' the function places the output flags value in the variable.
    Debug.Print Hex(lngFlags)
End Function

Function GetOpenFile(Optional varDirectory As Variant, _
    Optional varTitleForDialog As Variant) As Variant
' Here's an example that gets an Access database name.
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' Specify that the chosen file must already exist,
' don't change directories when you're done
' Also, don't bother displaying
' the read-only box. It'll only confuse people.
    lngFlags = ahtOFN_FILEMUSTEXIST Or _
                ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
    If IsMissing(varDirectory) Then
        varDirectory = ""
    End If
    If IsMissing(varTitleForDialog) Then
        varTitleForDialog = ""
    End If

    ' Define the filter string and allocate space in the "c"
    ' string Duplicate this line with changes as necessary for
    ' more file templates.
    strFilter = ahtAddFilterItem(strFilter, _
                "Access (*.mdb)", "*.MDB;*.MDA")
    ' Now actually call to get the file name.
    varFileName = ahtCommonFileOpenSave( _
                    OpenFile:=True, _
                    InitialDir:=varDirectory, _
                    Filter:=strFilter, _
                    Flags:=lngFlags, _
                    DialogTitle:=varTitleForDialog)
    If Not IsNull(varFileName) Then
        varFileName = TrimNull(varFileName)
    End If
    GetOpenFile = varFileName
End Function

Function ahtCommonFileOpenSave( _
            Optional ByRef Flags As Variant, _
            Optional ByVal InitialDir As Variant, _
            Optional ByVal Filter As Variant, _
            Optional ByVal FilterIndex As Variant, _
            Optional ByVal DefaultExt As Variant, _
            Optional ByVal FileName As Variant, _
            Optional ByVal DialogTitle As Variant, _
            Optional ByVal hwnd As Variant, _
            Optional ByVal OpenFile As Variant) As Variant
' This is the entry point you'll use to call the common
' file open/save dialog. The parameters are listed
' below, and all are optional.
'
' In:
' Flags: one or more of the ahtOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters, set up by calling
' AddFilterItem. See examples.
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the file name text box.
' DialogTitle: Title for the dialog.
' hWnd: parent window handle
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
    ' Give the dialog a caption title.
    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(FileName) Then FileName = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
    ' Allocate string space for the returned strings.
    strFileName = Left(FileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    ' Set up the data structure before you call the function
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hwnd
        .strFilter = Filter
        .nFilterIndex = FilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .Flags = Flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        ' Didn't think most people would want to deal with
        ' these options.
        .hInstance = 0
        '.strCustomFilter = ""
        '.nMaxCustFilter = 0
        .lpfnHook = 0
        'New for NT 4.0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With
    ' This will pass the desired data structure to the
    ' Windows API, which will in turn it uses to display
    ' the Open/Save As Dialog.
    If OpenFile Then
        fResult = aht_apiGetOpenFileName(OFN)
    Else
        fResult = aht_apiGetSaveFileName(OFN)
    End If

    ' The function call filled in the strFileTitle member
    ' of the structure. You'll have to write special code
    ' to retrieve that if you're interested.
    If fResult Then
        ' You might care to check the Flags member of the
        ' structure to get information about the chosen file.
        ' In this example, if you bothered to pass in a
        ' value for Flags, we'll fill it in with the outgoing
        ' Flags value.
        If Not IsMissing(Flags) Then Flags = OFN.Flags
        ahtCommonFileOpenSave = TrimNull(OFN.strFile)
    Else
        ahtCommonFileOpenSave = vbNullString
    End If
End Function

Function ahtAddFilterItem(strFilter As String, _
    strDescription As String, Optional varItem As Variant) As String
' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.

    If IsMissing(varItem) Then varItem = "*.*"
    ahtAddFilterItem = strFilter & _
                strDescription & vbNullChar & _
                varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function
'************** Code End *****************

[kishore.kr]

hi

could an expert help me set this up in access 2000

do you want to run this code with access or vb.

if it using vb then the following will do.,

you have to add reference of microsoft access object in your vb project if you want to work. i have attached your sample code itself. further why do you go for api, when you have commondialog. i have attached the code for that also in the same project (in form2).

Furthermore how i can refrence the loade .mdb file when ever i want to use it instead of current db in vba

for loading the mdb you dynamically use the provider with the mdb filename which you have selected..

i hope it will help you.

[tony007]

Thank u for u helpfull post. Well i am using access 2000. Could u tell me how to import these files to my project? Furthermore, could u show me how to use the loaded mdb file rather then current db.Thanks

[kishore.kr]

hi

attached the example in the same project itself. just after selecting the database, open the connection to the new database.

[kishore.kr]

hi again,
are you using commondialog or api(just wanted to know) ??. given example for commondialog. if you are using the api the place the con.open statement in the appropriate place of the api openfile fn.

[tony007]

hi again,
are you using commondialog or api(just wanted to know) ??. given example for commondialog. if you are using the api the place the con.open statement in the appropriate place of the api openfile fn.

Thank u for u reply. I want create a form in access 2000 and put a button and once i click on that button i want be able to browse for mdb file . In the same page i am trying to load all table names in lis box but tables from dynamically loaded db not current db. But i do not how to that part alo.Thanks

[kishore.kr]

hi buddy,

finally i got it(hope so). actually previously i was posting based on vb application. sorry for that.

i have added a form in access. it has a command button and combobox.
in the build event of the command button(using code builder), i have added code of the click event of the button. plus i have added the module which you had posted on the first post. it is working fine in my pc. you select any database the items will be added in the combo list. make modifications as you need.

[tony007]

Many thanks kishor for your help.Now the form loades the mdb file.However I want to do many things in this form after laoding external mdb file. For example i want to run the following code on click of a new button from the same form :

Private Sub Command0_Click()
CreateSystemCatalog
End Sub

Sub CreateSystemCatalog()
  Dim metadb As Database, db As Database
  Dim metadbname As String
  Set db = CurrentDb()  
metadbname = Left(db.Name, Len(db.Name) - 4) + "_meta.mdb"
  Set metadb = DBEngine.Workspaces(0).CreateDatabase(metadbname, dbLangGeneral)
  MsgBox (" System Catalgoe tables created succesfully! ")
  
  Call CreateSystemCatalogTables(metadb)
  Call InsertSystemCatalogPopulation(db, metadb)
End Sub

As u can see the above code is currently refrencing current db how i can make it to refrence the dynamically loaded one? I need to learn this since i got many codes as above that i want to apply it to loaded external mdb file. i be happy if u show me how to do it.Thanks

[kishore.kr]

hi,
try using
set db = opendatabase("databasefullpath with filename")
hope it works. i am not comfortable with dao. so only i send you the ado code. did you checked the code.

[tony007]

hi,
try using
set db = opendatabase("databasefullpath with filename")
hope it works. i am not comfortable with dao. so only i send you the ado code. did you checked the code.

Many thanks for u reply . Well yes i run your browse code . It run very well.

since i want to add another button to it to create system catalog for the current browsed file the "databasefullpath with filename " is changing each time i select a new mdb ! How to to put that automatically?(what i mean instead of Set db = CurrentDb() i want it rerfrences the browsed mdb).I want to acomplish this using eithr ado, dao.Thanks

[kishore.kr]

since i want to add another button to it to create system catalog for the current browsed file the "databasefullpath with filename " is changing each time i select a new mdb ! How to to put that automatically?(what i mean instead of Set db = CurrentDb() i want it rerfrences the browsed mdb).

i am not getting exactly what you want. can you put it more clearly. do you want a same method to open initially(first time) using currentdb and next(after opening new database) time with opendatabase().(is that you want).

[tony007]

i am not getting exactly what you want. can you put it more clearly. do you want a same method to open initially(first time) using currentdb and next(after opening new database) time with opendatabase().(is that you want).

Thanks for u reply. Well if i run the following code alone it will refrence the tables in current access db because of

"Set db = CurrentDb() "

Private Sub Command1_Click()
CreateSystemCatalog
End Sub

Sub CreateSystemCatalog()
  Dim metadb As Database, db As Database
  Dim metadbname As String
  Set db = CurrentDb()
  metadbname = Left(db.Name, Len(db.Name) - 4) + "_meta.mdb"
  Set metadb = DBEngine.Workspaces(0).CreateDatabase(metadbname, dbLangGeneral)
  MsgBox (" System Catalgoe tables created succesfully! ")
  
  Call CreateSystemCatalogTables(metadb)
  Call InsertSystemCatalogPopulation(db, metadb)
End Sub

But i want to run the following code but instead of refrencing the current access tables i want
to refrence the browsed external file.In another word i just want to run the below code but unfortunely the
CreateSystemCatalog() function refrences the tables in current db not the one that we justed browsed and loaded it!

Option Compare Database

Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Private Sub Command0_Click()
Set con = New ADODB.Connection
x = GetOpenFile("d:\", "Open Access files")

con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & x
Set rs = con.OpenSchema(adSchemaTables)
If x <> "" Then
    While Not rs.EOF
        Combo1.RowSource = Combo1.RowSource & ";" & rs!TABLE_NAME & ""
        rs.MoveNext
    Wend
End If
End Sub

Private Sub Command1_Click()
CreateSystemCatalog
End Sub

Sub CreateSystemCatalog()
  Dim metadb As Database, db As Database
  Dim metadbname As String
  Set db = CurrentDb()
  metadbname = Left(db.Name, Len(db.Name) - 4) + "_meta.mdb"
  Set metadb = DBEngine.Workspaces(0).CreateDatabase(metadbname, dbLangGeneral)
  MsgBox (" System Catalgoe tables created succesfully! ")
  
  Call CreateSystemCatalogTables(metadb)
  Call InsertSystemCatalogPopulation(db, metadb)
End Sub

[kishore.kr]

hi
try using like this

Option Compare Database
 
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Private Sub Command0_Click()
Set con = New ADODB.Connection
x = GetOpenFile("d:\", "Open Access files")
[COLOR=Yellow]'~~~~~~~~~~~~Instead of this code [/COLOR] 
'con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & x
'Set rs = con.OpenSchema(adSchemaTables)
'If x <> "" Then
'    While Not rs.EOF
'        Combo1.RowSource = Combo1.RowSource & ";" & rs!TABLE_NAME & ""
'        rs.MoveNext
'    Wend
'End If
[COLOR=Yellow]'~~~~~~~~~~~~use this code[/COLOR]
[COLOR=Plum]set db = opendatabase(x)
  metadbname = Left(db.Name, Len(db.Name) - 4) + "_meta.mdb"
  Set metadb = DBEngine.Workspaces(0).CreateDatabase(metadbname, dbLangGeneral)
  MsgBox (" System Catalgoe tables created succesfully! ")
  
  Call CreateSystemCatalogTables(metadb)
  Call InsertSystemCatalogPopulation(db, metadb)[/COLOR]
End Sub
 
Private Sub Command1_Click()
CreateSystemCatalog
End Sub
 
Sub CreateSystemCatalog()
  Dim metadb As Database, db As Database
  Dim metadbname As String
  Set db = CurrentDb()
  metadbname = Left(db.Name, Len(db.Name) - 4) + "_meta.mdb"
  Set metadb = DBEngine.Workspaces(0).CreateDatabase(metadbname, dbLangGeneral)
  MsgBox (" System Catalgoe tables created succesfully! ")
  
  Call CreateSystemCatalogTables(metadb)
  Call InsertSystemCatalogPopulation(db, metadb)
End Sub

[tony007]

Thanks kishor for u code. I tried this but i got error. Furthermore i want 2 buttons in this form. once for browsing the mdb file and one for firing the systemcataloge CreateSystemCatalogTables(metadb), InsertSystemCatalogPopulation(db, metadb) function. currently the code is working based on one button!I be happy if u help me fix this error.Thanks

Option Compare Database
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Private Sub Command0_Click()
Set con = New ADODB.Connection
x = GetOpenFile("d:\", "Open Access files")

Set db = OpenDatabase(x)
  metadbname = Left(db.Name, Len(db.Name) - 4) + "_meta.mdb"
  Set metadb = DBEngine.Workspaces(0).CreateDatabase(metadbname, dbLangGeneral)
  MsgBox (" System Catalgoe tables created succesfully! ")
  
  Call CreateSystemCatalogTables(metadb)
  Call InsertSystemCatalogPopulation(db, metadb)
End Sub

[kishore.kr]

if we are using db then there is no need for using adodb.connection. and can you find on which line the error is generated. means on the function name or the adodb declarations.

[kishore.kr]

if you want to use two buttons then declare the metadb in general declarations.

Option Compare Database
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
[COLOR=Red]Dim metadb
Dim db as database[/COLOR]
Private Sub Command0_Click()
Set con = New ADODB.Connection
x = GetOpenFile("d:\", "Open Access files")
 
Set db = OpenDatabase(x)
  metadbname = Left(db.Name, Len(db.Name) - 4) + "_meta.mdb"
  Set metadb = DBEngine.Workspaces(0).CreateDatabase(metadbname, dbLangGeneral)
  MsgBox (" System Catalgoe tables created succesfully! ")
End Sub
[COLOR=Red]Private Sub Command1_Click()
  Call CreateSystemCatalogTables(metadb)
  Call InsertSystemCatalogPopulation(db, metadb)
End Sub[/COLOR]

you did not specify on which line the error has occured

[tony007]

if you want to use two buttons then declare the metadb in general declarations.

Option Compare Database
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
[COLOR=Red]Dim metadb
Dim db as database[/COLOR]
Private Sub Command0_Click()
Set con = New ADODB.Connection
x = GetOpenFile("d:\", "Open Access files")
 
Set db = OpenDatabase(x)
  metadbname = Left(db.Name, Len(db.Name) - 4) + "_meta.mdb"
  Set metadb = DBEngine.Workspaces(0).CreateDatabase(metadbname, dbLangGeneral)
  MsgBox (" System Catalgoe tables created succesfully! ")
End Sub
[COLOR=Red]Private Sub Command1_Click()
  Call CreateSystemCatalogTables(metadb)
  Call InsertSystemCatalogPopulation(db, metadb)
End Sub[/COLOR]

you did not specify on which line the error has occured

Thanks kishor once again. I tried it and same error again!! It does not show me which linke. It happens when i jus click button command0!!

[kishore.kr]

hi
i think the error is simple. either you have not selected(tools->references) microsoft activex data objects library(9.0 like that) or the dao library. check it.

[nagasrikanth]

hi...
if this post was not yet completed then just have a look at attachment...
it will survives u r purpose..

[tony007]

hi...
if this post was not yet completed then just have a look at attachment...
it will survives u r purpose..

wow. Many thanks it worked well. could u tell me how did u deal with the browse part? did u use any wizard ? i never knew of this way . There is no moduel involved as i can see!

if i want to select one of the tables from list box and do some thing against it for example show its fields in massage box by pressing another button how i can re refrence that mdb. should i place

 Set w = DBEngine.Workspaces(0)
    Set d = w.OpenDatabase(cd.FileName)

in the event functon of the new button ?

Furthermore, for example if i want to run the following code against the browsed loaded mdb how i can refrence the browsed loaded mdb file ?As u see now it uses current db now !!

Private Sub Command1_Click()
CreateSystemCatalog
End Sub

Sub CreateSystemCatalog()
  Dim metadb As Database, db As Database
  Dim metadbname As String
  Set db = CurrentDb()
  metadbname = Left(db.Name, Len(db.Name) - 4) + "_meta.mdb"
  Set metadb = DBEngine.Workspaces(0).CreateDatabase(metadbname, dbLangGeneral)
  MsgBox (" System Catalgoe tables created succesfully! ")
  
  Call CreateSystemCatalogTables(metadb)
  Call InsertSystemCatalogPopulation(db, metadb)
End Sub

thanks

[nagasrikanth]

thanx..

If u see the form in design view , there is a control named COMMON DAILOG CONTROL.It will do the browsing part..

and coming to u r second question,see the attachment ..whenever u click on the list box..it will messages each and every filed in that particular table..

and coming to u r third question , declare u r variable globally...(in the new attachment all the necessary variables are declared globally)..
so that u can use the same database in the total module..

in case of queries plz revert back..if no queries...Please rate the post..