Allowing a User to Define Import Data location 1

[fockewulf190]

Hi all!

I'm trying to import the data from an Office 97 database table into an Office 2000 table.

What I need is a way to allow the user to choose from a dropdown box or drive window the location of the database to import from. The destination is already known.

Any suggestions?

Thanks

Charles

 

[allanon]

Try looking at this thread:

thread181-17350

 

[fockewulf190]

Thanks for the post Allanon but I'm blind as to the usage of the code. I understand what the people in the thread you sited are trying to do but I'm not sure as to where the coding should be done. Access will not allow me to use the Active X control mentioned in the first part of that post and as I've stated I'm not sure where that coding in the second part belongs. Direct me Sensei

 

[allanon]

Ok. This works good and you do not need the ocx control.

start a new module and place this code into it:

'***************** 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
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

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.
' 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 = "NoFile"
    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

When that is done set up a form with a command button on it.

place this code in the click event of the command button.

    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.

[\code]

This: ahtCommonFileOpenSave(InitialDir:="C:\", _
        filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
        DialogTitle:="Hello! Open Me!")

will give you your file path.

Have fun!

 

[fockewulf190]

Thanks Allanon that worked perfectly!
I have already created a macro that imports data from another database but that was when the path was preset. I want the window you helped me make to direct that macro to use the database chosen in the window as it's source for the data instead of the fixed path that I had put in the macro. I'm trying to import data from one table in an Office 97 external database into an Office 2000 database.
Any direction would be appreciated

Thanks

Charles

 

[allanon]

Unfortunately I have never used macros. I have less knowledge of how they work then you do.

Here is a suggestion. If you are importing from one access table to another why dont you just link to the original table and do an append query into the new table. That way you could use your open dialog box that you created above to set the link information and open the table. This gives you a couple of other advantages such as easy error handling and it's easily modifiable.

Let me know how this sounds to you. If not I can not help much with the macros. If you start a new thread asking how to enter a parameter (your path) in a macro I am sure someone else will be able to help.

 

[fockewulf190]

Thanks again Allanon. Linking the tables would work great but I'd have to have a way to allow the user to choose the path to get to the Access 97 Database. What I have done is made an updated Office 2000 version of an Office 97 database currently in use. I made an installation program for the new database (using 3rd party software) allowing the user to pop a CD with the new database into the CD ROM and it would install on it's own. I wanted the updated database to be able to import the data from the 97 database. The user would have to choose the path of the 97 database and then have that chosen path somehow used as the source for the import process.
Thanks again for your patience and assistance.

Charles

 

[allanon]

Here is what you do.

1) make sure your dao reference is set.

2) add this routine to your modules:

Sub ConnectOutput(dbsTemp As Database, _
strTable As String, strConnect As String, _
strSourceTable As String)

Dim tdfLinked As DAO.TableDef
Dim rstLinked As DAO.Recordset
Dim intTemp As Integer

' Create a new TableDef, set its Connect and
' SourceTableName properties based on the passed
' arguments, and append it to the TableDefs collection.
Set tdfLinked = dbsTemp.CreateTableDef(strTable)

tdfLinked.Connect = strConnect
tdfLinked.SourceTableName = strSourceTable
dbsTemp.TableDefs.Append tdfLinked

Set rstLinked = dbsTemp.OpenRecordset(strTable)

End Sub

(Straight out of the help files)

3) add this routine to your modules:

Sub DeleteConnection(dbsTemp As Database, strTable As String)
dbsTemp.TableDefs.Delete strTable
End Sub

4) add this routine to your modules:

Function CreateLinkedTables(strTblName As String, strDataBase As String)
Dim strConn As String
Dim tbl As TableDef
Dim db As Database

On Error GoTo CreateLinkedTables_Err

ConnectOutput CurrentDb(), _
"JetTable", _
";DATABASE=" & strDataBase, _
strTblName

CreateLinkedTables_End:
CreateLinkedTables = 0
Exit Function
CreateLinkedTables_Err:
MsgBox Err.Description, vbCritical, "Connection"
Resume CreateLinkedTables_End
End Function

here is how I used them:

I call the open dialog like this:

Function TestIt()
Dim strFilter As String
Dim lngFlags As Long
Dim dummy As Variant

strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
"*.MDA;*.MDB&quot
strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF&quot
strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT&quot
strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*&quot

dummy = CreateLinkedTables("TheRightFile", ahtCommonFileOpenSave(InitialDir:="C:\", _
filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="Hello! Open Me!&quot)
' Since you passed in a variable for lngFlags,
' the function places the output flags value in the variable.
End Function

(you will regognize some of this)

As you can see in the CreateLinkedTables I have hardcoded the table name "JetTable". You will most likely dynamically create a routine that passes the table names. I was lazy. This will create a link (Called JetTable in my case) to a table in the external db that I have selected. The parm "strTblName" is the name of the table that you want to link to.

That's all there is to it.

If you wish to delete the link after just add this call:

DeleteConnection CurrentDb(), "JetTable"

Have Fun!

 

[kbarber]

You can use the comdlg32.dll as follows:

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (lpOpenFilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (lpOpenFilename As OPENFILENAME) As Long
'TYPE: OPENFILENAME
'DESCRIPTION: Used by GetOpenFileName and GetSaveFileName API Call. Used to store settings for the Open File Window
'________________________________________________________________________________________________________________________________
Public Type OPENFILENAME
lStructSize As Long 'Size of the structure. Set this to the value returned from Len(x).
hwndOwner As Long 'Handle to the owner of this dialog. Use Application.hWndAccessApp
hInstance As Long 'Instance of the application. Use 0.
lpstrFilter As String 'The filter of the file types displayed in the Files of Type field. This string must be terminated with two null characters.
lpstrCustomFilter As String 'This parameter is a pointer to a buffer used to preserve the filter pattern chosen by the user.
nMaxCustFilter As Long 'The size in bytes of the buffer in lpstrCustomFilter.
nFilterIndex As Long 'The index of the filter you wish to set as the default.
lpstrFile As String 'The fully qualified path name of the file used to initialize the dialog. If you use this member, it must be preceded with a null character.
nMaxFile As Long 'The size in bytes of the buffer used for lpstrFile.
lpstrFileTitle As String 'Pointer to the buffer that receives the path and filename selected by the user.
nMaxFileTitle As Long 'Maximum length of the buffer specified in lpstrFileTitle.
lpstrInitialDir As String 'A string containing the initial directory. If this value is null, then the current directory is used. On Windows 2000 and Windows 98, if this value is null and the current directory contains files that match the specified file filter, the current directory is used. If no files match, the user's personal file directory of the current user is used.
lpstrTitle As String 'Caption of the dialog.
flags As Long 'A set of options used to configure the dialog. The flags are constants that begin with OFN_.
nFileOffset As Integer 'Specifies the number of bytes to the first character in the filename. This allows you to extract the filename from the path. Since the number is zero-based, subtract one from the value returned in this member.
nFileExtension As Integer 'Specifies the number of bytes to the first character of the file extension. Since the number is zero-based, subtract one from the value returned in this member.
lpstrDefExt As String 'Default extension of the file. Used when called by GetSaveFileName.
lCustData As Long 'Custom data passed to the message handler specified in the lpfnHook member.
lpfnHook As Long 'The address of the hook procedure. To enable a message hook, set the OFN_ENABLEHOOK flag in addition to any other flags.
lpTemplateName As String 'Pointer to a string that names the template dialog included in the resource specified by the hInstance member.
End Type

Public Function gsGetFileName(psDialogTitle As String, pbSaveDialog As Boolean, pbOpenDialog As Boolean, Optional psSaveFileType As String, Optional psInitialDir As String) As String
Dim liReturnCode As Long
Dim lpOpenFilename As OPENFILENAME
Dim lsInitialDir As String
Dim lsInitialDirWithFile As String
Dim lsFilterDesc As String
Dim lsFilterPattern As String
Dim lsFileName As String
Dim lsSaveFileType As String
Dim liUptoDot As Integer
Dim liLength, listring As Integer
Dim lsString As String
Dim lsDatabaseName As String

Const MAX_BUFFER_LENGTH = 256

On Error GoTo GetFileName_Error

'CHECK THAT SAVE OR OPEN HAS BEEN INDICATED BUT NOT BOTH
If pbSaveDialog And pbOpenDialog Then
MsgBox "Please indicate that you want either the 'Save' or 'Open' Dialogs! Not Both.", vbCritical, "Error Getting File Name"
End If

If Not pbSaveDialog And Not pbOpenDialog Then
MsgBox "Please indicate that you want either the 'Save' or 'Open' Dialogs! ", vbCritical, "Error Getting File Name"
End If

'SET THE DEFAULT SAVE FILE TYPE
If IsNull(psSaveFileType) Then
lsSaveFileType = ""
Else
lsSaveFileType = psSaveFileType
End If

With lpOpenFilename
.hwndOwner = Application.hWndAccessApp
.hInstance = 0
.lpstrTitle = psDialogTitle
.lpstrInitialDir = psInitialDir
.lpstrFilter = "All Files" & " " & "*.*" & " "
.nFilterIndex = 1
If pbSaveDialog Then
.lpstrDefExt = ".txt"
End If
.lpstrFile = String(MAX_BUFFER_LENGTH, 0)
.nMaxFile = MAX_BUFFER_LENGTH - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = MAX_BUFFER_LENGTH - 1
.lStructSize = Len(lpOpenFilename)
End With


If pbOpenDialog Then
liReturnCode = GetOpenFileName(lpOpenFilename)
Else
liReturnCode = GetSaveFileName(lpOpenFilename)
End If

If liReturnCode Then
'A file selected
lsFileName = Left$(lpOpenFilename.lpstrFile, lpOpenFilename.nMaxFile)
'Remove the null chars
lsFileName = Left(lsFileName, InStr(lsFileName, vbNullChar) - 1)
Else
'The cancel button was pressed
lsFileName = ""
End If

GetFileName_Exit:
gsGetFileName = lsFileName
Exit Function
GetFileName_Error:
MsgBox Err.Description, vbInformation, "Error Getting FileName"
Resume GetFileName_Exit
End Function

Call the function like this:

Public Sub test()
Dim lsFileName As String

lsFileName = gsGetFileName("Get File", False, True, , "c:\&quot
End Sub

 

[fockewulf190]

Allanon, I pasted all of the following into a module but changed the names of a couple of files. The OnClick works.. it opens the dialog box and allows me to choose the database I want to use. After selecting the database to import from I get the following error:

Microsoft Jet Database engine could not find the object
'TheRightFile'.



Sub ConnectOutput(dbsTemp As Database, _
strTable As String, strConnect As String, _
strSourceTable As String)

Dim tdfLinked As DAO.TableDef
Dim rstLinked As DAO.Recordset
Dim intTemp As Integer

' Create a new TableDef, set its Connect and
' SourceTableName properties based on the passed
' arguments, and append it to the TableDefs collection.
Set tdfLinked = dbsTemp.CreateTableDef(strTable)

tdfLinked.Connect = strConnect
tdfLinked.SourceTableName = strSourceTable
dbsTemp.TableDefs.Append tdfLinked

Set rstLinked = dbsTemp.OpenRecordset(strTable)

End Sub

Sub DeleteConnection(dbsTemp As Database, strTable As String)
dbsTemp.TableDefs.Delete strTable
End Sub

Function CreateLinkedTables(tbSoldier As String, strDataBase As String)
Dim strConn As String
Dim tbl As TableDef
Dim db As Database

On Error GoTo CreateLinkedTables_Err

ConnectOutput CurrentDb(), _
"tbSoldier", _
";DATABASE=" & strDataBase, _
tbSoldier

CreateLinkedTables_End:
CreateLinkedTables = 0
Exit Function
CreateLinkedTables_Err:
MsgBox Err.Description, vbCritical, "Connection"
Resume CreateLinkedTables_End
End Function

Private Sub Command11_Click()
Dim strFilter As String
Dim lngFlags As Long
Dim dummy As Variant

strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
"*.MDA;*.MDB&quot
' strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF&quot
' strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT&quot
strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*&quot

dummy = CreateLinkedTables("TheRightFile", ahtCommonFileOpenSave(InitialDir:="C:\", _
filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="Hello! Open Me!&quot)
' Since you passed in a variable for lngFlags,
' the function places the output flags value in the variable.
End Sub

 

[allanon]

ok, "TheRightFile" is actually a table name in the remote database.

You will have to enter the name of one of the tables from you acc97 db in that spot.

dummy = CreateLinkedTables("Your remote table name", ahtCommonFileOpenSave(InitialDir:="C:\", _
filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="Hello! Open Me!&quot)

 

[fockewulf190]

Allanon,

Works Great!!!! I'm learning.... just one more obstacle for me to overcome. The table I'm importing has a table it shares information with. Can I import that table along with the main table? If so how?


Thanks
Charles

 

[allanon]

Change the click event to store the location of the remote database.

add a string variable:

Dim strLocation as String

Then add this line:

strLocation = ahtCommonFileOpenSave(InitialDir:="C:\", _
filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="Hello! Open Me&quot

Instead of:

dummy = CreateLinkedTables("Your remote table name", ahtCommonFileOpenSave(InitialDir:="C:\", _
filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="Hello! Open Me!&quot)


Finally place these two lines after the strLocation line:

dummy = CreateLinkedTables("Your remote table1 name", strLocation)

dummy = CreateLinkedTables("Your remote table2 name", strLocation)

 

[fockewulf190]

Allanon,

That coding worked but when the second table is being imported I get an error message saying that object tbSoldierIMPORT already exists. Could this be because there's no coding telling it to create the second table in the database I'm importing to?

Thanks

Charles

 

[allanon]

Here is what I suggest you do.

Change this routine: to be:

Function CreateLinkedTables(tblExternalFile As String, tblInternalFile as string, strDataBase As String)
Dim strConn As String
Dim tbl As TableDef
Dim db As Database

On Error GoTo CreateLinkedTables_Err

ConnectOutput CurrentDb(), _
tblInternalFile, _
";DATABASE=" & strDataBase, _
tblExternalFile

CreateLinkedTables_End:
CreateLinkedTables = 0
Exit Function
CreateLinkedTables_Err:
MsgBox Err.Description, vbCritical, "Connection"
Resume CreateLinkedTables_End
End Function


Then change the call to:

dummy = CreateLinkedTables("Your remote table1 name", "Your internal Table Name", strLocation)

dummy = CreateLinkedTables("Your remote table2 name", "Your internal Table2 Name", strLocation)

Now what you do when you do your call is you pass then name of the new connection as one of your parameters. EG:

dummy = CreateLinkedTables("MyRemoteTable", "MyInternalTable", strLocation)

Now you can create as many table connections as you want. One suggestion tho; keep your internal connection name and your external table names the same if you can. If you already have internal tables with thos names then prefix the names. something like

dummy = CreateLinkedTables("MyRemoteTable", "lnkMyRemoteTable", strLocation)

In this manner you will always know what the link is used for.