Automated import from other database

[The_Doc_Man]

Both variants work and should produce the same execution plan.

Depending on indexing, maybe NOT the same plan. Perhaps you don't need an index, but EVERY article I look up to answer the question of whether or not an index is needed says, "In practical terms, yes." (In technical requirements, no.) I.e. you'd be very sorry if you didn't have one.

But the two queries ARE different in one major way. If you look up the "Order of SQL execution" you would find that the JOIN and FROM clauses are processed first, FOLLOWED by any WHERE clauses. The JOIN version reduces the number of records to be processed by the WHERE clause (if any) whereas the non-JOIN version has a Cartesian JOIN set for the WHERE to process. So if there ARE extra criteria for the WHERE clause (in the non-JOIN example), they have more work to do. The WHERE clause in the JOIN example has already had a reduction in the potential size of the return set.

 

[fd110]

I have found a code that takes the file and deletes the tables completely.

In this case, it is difficult to use join
If it is possible to change the code so that it first imports all the tables into the database, for example, import_takhrij, and then upserts the information using join, and then deletes the import tables, it would be great.
But unfortunately, I don't know anything about this!!

Option Compare Database
Public Type RecRelation
    rName As String
    rAttr As Integer
    rTable As String
    rFtable As String
    rFields As DAO.Fields
End Type
Function ImportRecords()
    Dim recRel() As RecRelation
    Dim Rel As Relation, fld As DAO.Field
    Dim k As Integer, j As Integer
    Dim strSource As String
    Dim tbl As TableDef
    Dim s As String
    strSource = fFileDialogAns(msoFileDialogFilePicker, "", "", "Access Database", "*.accdb;*.mdb")
    If strSource = "" Then Exit Function
    'strSource = CurrentProject.Path & "\old.mdb"
    If CheckTableMatch(strSource) Then
        If MsgBox("ãíÓÑ¡ ÌÏÇæá æ ÝíáÏåÇí ãÈÏÇ ÕÍíÍ ÇÓÊ . ÈÇ ÌÇíÒíäí ÇØáÇÚÇÊ ÌÏÇæá ãæÇÝÞ åÓÊíÏ¿", vbYesNo + vbExclamation + vbMsgBoxRight) = vbNo Then Exit Function
    Else
        Exit Function
    End If
    k = CurrentDb.Relations.Count
    DoCmd.SetWarnings False
    If k Then
        k = k - 1
        ReDim recRel(k)
        k = 0
        For Each Rel In CurrentDb.Relations
            recRel(k).rAttr = Rel.Attributes
            recRel(k).rName = Rel.Name
            recRel(k).rTable = Rel.Table
            recRel(k).rFtable = Rel.ForeignTable
            p = Rel.Fields.Count
            Set recRel(k).rFields = Rel.Fields
            CurrentDb.Relations.Delete Rel.Name
            k = k + 1
        Next Rel
    End If
    'On Error Resume Next
   'DELETE Tables content & insert
    
    For Each tbl In CurrentDb.TableDefs
        If tbl.Attributes = 0 Then

'this part need change !!!!!!!!!!!!!!! somthing like below ofcource after import tables!!!!!!!!!!!!!!!!!!!!!!!!!!
       strSQL = "UPDATE" & tbl.Name & "RIGHT JOIN" & tbl.Name & "ON" & tbl.Name.key1 = tbl.Name.key1 And tbl.Name.key2 = tbl.Name.key2 & "SET tblData.StartDate = [tblImport].StartDate, tblData.EndDate = [tblImport].EndDate, tblData.NCheck = tblImport.[NCheck];"

          
            DoCmd.RunSQL strSQL
           ' strSQL = "INSERT INTO " & tbl.Name & " SELECT * FROM " & tbl.Name & " IN '" & strSource & "'"
           ' DoCmd.RunSQL strSQL
        End If
    Next
    If k Then
        'On Error GoTo 0
        For k = 0 To UBound(recRel)
            Set Rel = CurrentDb.CreateRelation(recRel(k).rName, recRel(k).rTable, recRel(k).rFtable, recRel(k).rAttr)
            For j = 0 To recRel(k).rFields.Count - 1
                Set fld = Rel.CreateField(recRel(k).rFields(j).Name)
                fld.ForeignName = recRel(k).rFields(j).ForeignName
                Rel.Fields.Append fld
            Next
            CurrentDb.Relations.Append Rel
        Next
    End If
    DoCmd.SetWarnings True
    MsgBox "ÚãáíÇÊ ÌÇíÒíäí ÈÇ ãæÝÞíÊ Èå ÇíÇä ÑÓíÏ"
End Function
Function GetFieldVal(tdf As String, fld As String, Optional Criteria As String = " (1) ", Optional ExternalDb As String = "") As Variant
    Dim rs As DAO.Recordset
    Dim db As Database
    Dim strSQL As String
    If ExternalDb <> "" Then
        Set db = DBEngine.OpenDatabase(ExternalDb)
    Else
        Set db = CurrentDb
    End If
    strSQL = "SELECT " & fld & " FROM " & tdf & " WHERE " & Criteria
    Set rs = db.OpenRecordset(strSQL)
    GetFieldVal = Nz(rs.Fields(0))
End Function

Function CheckTableMatch(ExternalDb As String) As Boolean
    Dim db As Database, tbl As DAO.TableDef, fld As DAO.Field, ExFld As DAO.Field
    Dim blnFldMatch As Boolean, k As Integer
    If Dir(ExternalDb) = "" Then
        MsgBox "ÝÇíá ãÈÏÇ æÌæÏ äÏÇÑÏ"
        Exit Function
    End If
    
    Set db = DBEngine.OpenDatabase(ExternalDb)
    For Each tbl In CurrentDb.TableDefs
        If tbl.Attributes = 0 Then
            k = GetFieldVal("MSysObjects", "Count(*)", "Name = '" & tbl.Name & "' AND (Type = 1) ", ExternalDb)
            If k = 0 Then
                MsgBox "ÇäÌÇã ÚãáíÇÊ ÈÚáÊ ÚÏã æÌæÏ ÌÏæá(åÇ) Çã˜Çä ÐíÑ äãí ÈÇÔÏ"
                Exit Function
            Else
                For Each fld In tbl.Fields
                    blnFldMatch = False
                    For Each ExFld In db.TableDefs(tbl.Name).Fields
                        If ExFld.Name = fld.Name Then blnFldMatch = True
                    Next ExFld
                    If Not blnFldMatch Then
                        MsgBox "ÇäÌÇã ÚãáíÇÊ ÈÏáíá ÚÏã ÊØÇÈÞ ÝíáÏ Çã˜Çä ÐíÑ äãí ÈÇÔÏ"
                        Exit Function
                    End If
                Next fld
            End If
        End If
    Next tbl
    Set db = Nothing
    CheckTableMatch = True
End Function

Function MissedID(tdfName As String, fldName As String)
    Dim strSQL As String, k As Integer
    Dim rs As DAO.Recordset
    Dim ListOfID() As Integer, j As Integer
    Set rs = CurrentDb.OpenRecordset(tdfName)
    With rs
        .MoveLast
        .MoveFirst
        k = rs.Fields(fldName)
        For k = k To .RecordCount
            If k <> .Fields(fldName) Then
                ReDim Preserve ListOfID(j)
                ListOfID(j) = k
                j = j + 1
            End If
            .MoveNext
        Next
        .Close
    End With
    Set rs = Nothing
    MissedID = ListOfID
End Function


Public Function fFileDialogAns(dlgType As MsoFileDialogType, Optional sPath As String = "", Optional sFileName As String = "", _
 Optional sFilterDesc As String = "", Optional sFilterExtention As String = "", Optional MultiSel As Boolean) As String
Dim dlg As FileDialog
Dim varSelItems As Variant
Dim k As Integer, s As String, S2 As String, strOpenFile As String
fFileDialogAns = ""
    Set dlg = Application.FileDialog(dlgType)
    dlg.AllowMultiSelect = MultiSel
    If dlgType = msoFileDialogSaveAs Then
        dlg.title = "ÐÎíÑå ÝÇíá"
        dlg.InitialFileName = sPath & "\" & sFileName
        dlg.ButtonName = "ÐÎíÑå"
    ElseIf dlgType = msoFileDialogFilePicker Then
        dlg.title = "ÇäÊÎÇÈ ÝÇíá"
        dlg.Filters.Add sFilterDesc, sFilterExtention, 1
        dlg.InitialFileName = sPath
        dlg.ButtonName = "ÇäÊÎÇÈ"
    Else
        dlg.title = "ÇäÊÎÇÈ æÔå"
        dlg.InitialFileName = sPath & "\"
    End If
    If dlg.Show = True Then

        'dlgType=msoFileDialogFolderPicker
        'strOpenFile = dlg.InitialFileName
    Else
        Set dlg = Nothing
        Exit Function
    End If
    sPath = ""
    For Each varSelItems In dlg.SelectedItems
        sPath = sPath & varSelItems & ";"
    Next
    sPath = Left(sPath, Len(sPath) - 1)
    Set dlg = Nothing
    If dlgType = msoFileDialogFilePicker Or dlgType = msoFileDialogFolderPicker Then
        fFileDialogAns = sPath
        Exit Function
    End If
    ' verify extention
    k = InStrRev(sPath, ".")
    s = Right(sPath, Len(sPath) - k)
    k = InStrRev(sFileName, ".")
    S2 = Right(sFileName, Len(sFileName) - k)
    If s <> S2 Then Exit Function
    
    fFileDialogAns = sPath
End Function

 

[fd110]

You appear to be confusing your terminology. You don't join tables with multiple keys.

If you can add a part to your code that has a dialog file and imports the tables to the database with an imported extension, it will be much easier to transfer information and left join with existing tables.
thanks

Sub ImportTablesFromExternalDB()
    Dim externalDBPath As String
    Dim suffix As String
    Dim db As DAO.Database
    Dim tbl As DAO.TableDef
    Dim newTableName As String
    Dim dlg As FileDialog
    
    ' Create a file dialog object
    Set dlg = Application.FileDialog(msoFileDialogFilePicker)
    
    ' Set the file dialog title
    dlg.Title = "Select the external database file"
    
    ' Show the file dialog and check if a file was selected
    If dlg.Show = -1 Then
        ' Get the selected file path
        externalDBPath = dlg.SelectedItems(1)
    Else
        ' User canceled, exit the sub
        Exit Sub
    End If
    
    ' Set the suffix to be added to the table names
    suffix = "_imported"
    
    ' Open the external database
    Set db = OpenDatabase(externalDBPath)
    
    ' Loop through each table in the external database
    For Each tbl In db.TableDefs
        ' Exclude system tables
        If Left(tbl.Name, 4) <> "MSys" Then
            ' Create a new table name with the added suffix
            newTableName = tbl.Name & suffix
            
            ' Import the table into the current database with the new name
            DoCmd.TransferDatabase acImport, "Microsoft Access", externalDBPath, acTable, tbl.Name, newTableName
        End If
    Next tbl
    
    ' Close the external database
    db.Close
    Set db = Nothing
End Sub

 

[fd110]

gpt suggest!!

Option Compare Database

Sub ImportAndCompareTables()
    Dim db As DAO.Database
    Dim tbl As DAO.TableDef
    Dim newTableName As String
    Dim rsExisting As DAO.Recordset
    Dim rsImported As DAO.Recordset
    Dim strSQL As String
    Dim fld As DAO.Field
    Dim fd As FileDialog
    Dim selectedFile As String
    
    ' Open the file dialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .AllowMultiSelect = False
        .title = "انتخاب فایل برای دریافت اطلاعات"
        If .Show = -1 Then
            selectedFile = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ' Open the selected external database
    Set db = OpenDatabase(selectedFile)
    
    ' Import each table from the external database
    For Each tbl In db.TableDefs
        ' Ignore system tables
        If Not tbl.Name Like "MSys*" Then
            ' Generate a new table name
            newTableName = "Imported_" & tbl.Name
            
            ' Check if the table already exists in the current database
            If Not TableExists(newTableName) Then
                ' Create a new table with the imported table structure
                DoCmd.TransferDatabase acImport, "Microsoft Access", selectedFile, acTable, tbl.Name, newTableName
            End If
            
            ' Compare the existing and imported tables
            Set rsExisting = CurrentDb.OpenRecordset(newTableName)
            Set rsImported = db.OpenRecordset(tbl.Name)
            
            While Not rsImported.EOF
                ' Check if the record already exists in the existing table
                strSQL = "SELECT * FROM " & newTableName & " WHERE "
                For Each fld In rsImported.Fields
                    strSQL = strSQL & fld.Name & " = " & ConvertToSQL(fld.Value) & " AND "
                Next fld
                strSQL = Left(strSQL, Len(strSQL) - 5)
                rsExisting.FindFirst strSQL
                
                If Not rsExisting.NoMatch Then
                    ' Update the existing record
                    For Each fld In rsImported.Fields
                        rsExisting(fld.Name) = fld.Value
                    Next fld
                    rsExisting.Update
                Else
                    ' Add the record to the existing table
                    rsExisting.AddNew
                    For Each fld In rsImported.Fields
                        rsExisting(fld.Name) = fld.Value
                    Next fld
                    rsExisting.Update
                End If
                
                rsImported.MoveNext
            Wend
            
            rsExisting.Close
            rsImported.Close
        End If
    Next tbl
    
    ' Close the external database
    db.Close
    Set db = Nothing
End Sub

Function ConvertToSQL(ByVal vValue As Variant) As String
    If IsNull(vValue) Then
        ConvertToSQL = "NULL"
    ElseIf VarType(vValue) = vbString Then
        ConvertToSQL = "'" & Replace(vValue, "'", "''") & "'"
    ElseIf VarType(vValue) = vbDate Then
        ConvertToSQL = "#" & Format$(vValue, "yyyy\/mm\/dd hh\:nn\:ss") & "#"
    Else
        ConvertToSQL = vValue
    End If
End Function

Function TableExists(ByVal tableName As String) As Boolean
    Dim tdf As DAO.TableDef
    Dim db As DAO.Database
    
    Set db = CurrentDb()
    
    For Each tdf In db.TableDefs
        If tdf.Name = tableName Then
            TableExists = True
            Exit Function
        End If
    Next tdf
    
    TableExists = False
End Function

 

[isladogs]

If you can add a part to your code that has a dialog file and imports the tables to the database with an imported extension, it will be much easier to transfer information and left join with existing tables.
thanks

Sorry. The two articles were the result of several hours work and I'm not intending to add anything more to them.
All the methods you may need are included already.