Importing tables from other access database using code

[anb001]

Does anyone know how to import tables from another access database file, by using code? What I'm looking for is code for a button, which will let you browse for a specific file. When file is chosen, it should show path in a text box, and after you click on an 'update' button, all tables from that access database file, should be imported into the current one. The imported tables, should just overwrite existing ones, in case names are identical.

Appreciate any help you can give, as I'm quite lost.

 

[cpgospi]

Here you go. I didn't write this code but I've been using this for some time. (I don't remember where I got it, so I apologize to the author)


Function for getting file name (can paste this into a module)

' Declarations
' (Copy them to the (declarations) section of a module.)
Public Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustomFilter As Long
    nFilterIndex As Long
    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
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_PATHMUSTEXIST = &H800
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long
    
Public Function PromptFileName() As String
    Dim filebox As OPENFILENAME  ' open file dialog structure
    Dim FName As String          ' filename the user selected
    Dim result As Long           ' result of opening the dialog
    
    ' Configure how the dialog box will look
    With filebox
        ' Size of the structure.
        .lStructSize = Len(filebox)
        ' Handle to window opening the dialog.
        .hwndOwner = 0 'Me.Hwnd
        ' Handle to calling instance (not needed).
        .hInstance = 0
        ' File filters to make available: Access Databases and All Files
        .lpstrFilter = "Access Databases (*.mdb)" & vbNullChar & "*.mdb" & _
            vbNullChar & "All Files (*.*)" & vbNullChar & "*.*" & _
            vbNullChar & vbNullChar
        '.lpstrCustomFilter is ignored -- unused string
        .nMaxCustomFilter = 0
        ' Default filter is the first one (Text Files, in this case).
        .nFilterIndex = 1
        ' No default filename.  Also make room for received
        ' path and filename of the user's selection.
        .lpstrFile = Space(256) & vbNullChar
        .nMaxFile = Len(.lpstrFile)
        ' Make room for filename of the user's selection.
        .lpstrFileTitle = Space(256) & vbNullChar
        .nMaxFileTitle = Len(.lpstrFileTitle)
        ' Initial directory is C:\.
        .lpstrInitialDir = "C:\" & vbNullChar
        ' Title of file dialog.
        .lpstrTitle = "Select a File" & vbNullChar
        ' The path and file must exist; hide the read-only box.
        .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
        ' The rest of the options aren't needed.
        .nFileOffset = 0
        .nFileExtension = 0
        '.lpstrDefExt is ignored -- unused string
        .lCustData = 0
        .lpfnHook = 0
        '.lpTemplateName is ignored -- unused string
    End With
    
    ' Display the dialog box.
    result = GetOpenFileName(filebox)
    If result <> 0 Then
        ' Remove null space from the file name.
        FName = Left(filebox.lpstrFile, InStr(filebox.lpstrFile, vbNullChar) - 1)
        'Debug.Print "The selected file: "; fname
    End If
    
    'return the string of the file name
    PromptFileName = FName
    
End Function

And here is sub for a button (I use this to re-link tables but have modified it to import):

Private Sub cmdLinkTables_Click()
On Error GoTo Err_cmdLinkTables_Click

    Dim strFileName, strTableName As String
    
    strFileName = PromptFileName()
    
    Dim obj As AccessObject, dbs As Object
    
    Set dbs = Application.CurrentData
    ' Search for open AccessObject objects in AllTables collection.
    For Each obj In dbs.AllTables
        strTableName = obj.Name
        'Some other objects in the .AllTables Collection are not tables
        If Not (Left(strTableName, 4) = "MSys") Then
            '1. Delete the current link
            DoCmd.DeleteObject acTable, strTableName
            'This MsgBox was used to debug.  Comment out or delete as you like
            '2. Re-Link the table
            'MsgBox "Linking " & strTableName & "."
            DoCmd.TransferDatabase acImport, "Microsoft Access", strFileName, _
                acTable, strTableName, strTableName
        End If
    Next obj

Exit_cmdLinkTables_Click:
    Exit Sub

Err_cmdLinkTables_Click:
    MsgBox Err.Description
    Resume Exit_cmdLinkTables_Click

End Sub

Hope this helps. Let me know if you have any questions with code.


Chris

 

[anb001]

Chris,
Thanks a lot. Worked like a charm.

I have some additional questions, though, for which I hope you can help.

1. When clicking the 'Cancel' button in the 'Select a file' dialog, I just get a box, which states 'invalid aragument'. What I would like, when clicking the 'cancel' button, is just that the dialog should close, without any msgs.

2. When clicking 'ok' to import the tables, I would like a a msg asking the user to confirm that the tables should be imported, and a msg stating that tables have been imported.


Thnks a lot.

 

[anb001]

When using below code, all tables in the current database are deleted, after which all tables from selected database will be imported.

Private Sub cmdImport_Click()
On Error GoTo Err_cmdLinkTables_Click

    Dim strFileName, strTableName, strImport As String
    
    strFileName = PromptFileName()
    
    If strFileName = "" Then
    Exit Sub
    End If
    
   strImport = MsgBox("Importing data from selected file, will delete all data in current file. Please confirm?", vbYesNo, "Confirm data import")

    If strImport = 6 Then
        
    Dim obj As AccessObject, dbs As Object
    
    Set dbs = Application.CurrentData
    ' Search for open AccessObject objects in AllTables collection.
    For Each obj In dbs.AllTables
        strTableName = obj.Name
        'Some other objects in the .AllTables Collection are not tables
        If Not (Left(strTableName, 4) = "MSys") Then
            '1. Delete the current link
            DoCmd.DeleteObject acTable, strTableName
            'This MsgBox was used to debug.  Comment out or delete as you like
            '2. Re-Link the table
            'MsgBox "Linking " & strTableName & "."
            DoCmd.TransferDatabase acImport, "Microsoft Access", strFileName, _
                acTable, strTableName, strTableName
        
        End If
    Next obj

ElseIf strImport = 5 Then
Exit Sub

End If

Exit_cmdLinkTables_Click:
    Exit Sub

Err_cmdLinkTables_Click:
    MsgBox Err.Description
    Resume Exit_cmdLinkTables_Click

End Sub

I would like it a little bit different.

1. Before deleting, the selected database should be checked, to see if there is some tables in there. If there is no tables in the selected database, then nothing should be deleted from the current database. If there are tables in the selected database, all should be deleted from the current database, and all should be imported from the selected database. This goes no matter if there are tables or not in the current database.

2. Need some msg boxes, to inform the user, whether anything has been imported or not.

Above probably sound a little complicated, but hope that someone can help anyway.

 

[halewilson]

Aloha cpgospi,
I found the above code very usefull....thanks. But is there a way to rename the table before it is imported? ...and also to cancel without deleting existing tables?

Many thanks