• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Export Source Table from Current Database To The Destination Table In New Database ( IN ACCESS )

Export Source Table from Current Database To The Destination Table In New Database ( IN ACCESS )

Export Source Table from Current Database To The Destination Table In New Database ( IN ACCESS )

API Declarations


Dim AccesApp As Access.Application
Dim Newdatabasepath As String
Dim fso As FileSystemObject



Rate Export Source Table from Current Database To The Destination Table In New Database ( IN ACCESS )

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Public Sub ExportTable(ByVal strCurrentdatabasepath As String, ByVal strNewDatabasePath As String, ByVal strSourceTableName As String, ByVal strDestinationTableName As String)
On Error GoTo errcheck:
'***********************************************************************************************************************************************************************************
    Set fso = New FileSystemObject
    If fso.FileExists(strCurrentdatabasepath) = False Then
        MsgBox "Invalid Current DataBase"
        Exit Sub
    ElseIf fso.FileExists(strNewDatabasePath) = False Then
        MsgBox "Invalid Destination Database"
        Exit Sub
    ElseIf strDestinationTableName = "" Or strDestinationTableName = " " Then
        MsgBox "Please Eneter Destination TableName "
        Exit Sub
    ElseIf strSourceTableName = "" Or strSourceTableName = " " Then
        MsgBox "Please Eneter Source TableName "
        Exit Sub
    End If
    Set AccesApp = New Access.Application
    Newdatabasepath = strNewDatabasePath
'Open and set the path for the current database
    AccesApp.OpenCurrentDatabase strCurrentdatabasepath
'Export the Source table from current database to The Destination table in the back-up / new  database
    AccesApp.DoCmd.TransferDatabase acExport, "Microsoft Access", Newdatabasepath, acTable, strSourceTableName, strDestinationTableName
    MsgBox "Table Successfully Exported"
'***********************************************************************************************************************************************************************************
    AccesApp.CloseCurrentDatabase
    AccesApp.Quit
    Set AccesApp = Nothing
    Set fso = Nothing
'***********************************************************************************************************************************************************************************
Exit Sub
errcheck:
    MsgBox Err.Description
End Sub