Solved Unable to Insert/Update DB

[Reshmi mohankumar]

Hi,
I wish to update my present working securedDB with structure updated secured DB by using below code.
But there is no response/ error when excutes. Even tried by removing password to DB at source.
If password exists then error 3031 appearing at OpenDatabase.
Any helpful suggestions will be accepted.

Sub CopyTablesBetweenDatabases()
    Dim sourceDB As DAO.Database
    Dim targetDB As DAO.Database
    Dim tbl As DAO.TableDef
    Dim sourceTableName As String
    Dim targetTableName As String
    
    ' Set the source and target database file paths
    Dim sourceDBPath As String
    Dim targetDBPath As String

    sourceDBPath = CurrentProject.Path & "\structure\HardwareBE.accdb"
    targetDBPath = CurrentProject.Path & "\HardwareBE.accdb"
    ' connect = "[;DATABASE=" & sourceDBPath & ";PWD=rmk3200125]"
    ' Open the source and target databases
    Set sourceDB = OpenDatabase(sourceDBPath)
    Set targetDB = OpenDatabase(targetDBPath)
    
    ' Loop through all tables in the source database
    For Each tbl In sourceDB.TableDefs
        sourceTableName = tbl.Name
        targetTableName = tbl.Name
        
        ' Check if the table name already exists in the target database
        If Not TableExists(targetDB, targetTableName) Then
            ' Copy the table structure and data
            MsgBox "Start"
            DoCmd.TransferDatabase acImport, "Microsoft Access", targetDBPath, acTable, sourceTableName, targetTableName, 1
            MsgBox "End"
        End If
    Next tbl
    
    ' Close the databases
    sourceDB.Close
    targetDB.Close
    
    ' Release the database objects
    Set sourceDB = Nothing
    Set targetDB = Nothing
End Sub

Function TableExists(db As DAO.Database, tableName As String) As Boolean
    ' Check if a table exists in the specified database
    On Error Resume Next
    TableExists = Not (db.TableDefs(tableName) Is Nothing)
    On Error GoTo 0
End Function

 

[ebs17]

' connect = "[;DATABASE=" & sourceDBPath & ";PWD=rmk3200125]"
' ...
Set targetDB = OpenDatabase(targetDBPath)

My first thought would be that it's not enough to just list a password in a comment. You should use it when opening the database.

Second thought:
OpenDatabase is a method of DAO.
DoCmd.TransferDatabase is a method of the Access object.
Both are fundamentally different accesses, which should be taken into account when transferring a password.

 

[Reshmi mohankumar]

' connect = "[;DATABASE=" & sourceDBPath & ";PWD=rmk3200125]"
' ...
Set targetDB = OpenDatabase(targetDBPath)

My first thought would be that it's not enough to just list a password in a comment. You should use it when opening the database.

It says invalid password..Thats why i removed password and tried.

 

[Reshmi mohankumar]

' connect = "[;DATABASE=" & sourceDBPath & ";PWD=rmk3200125]"
' ...
Set targetDB = OpenDatabase(targetDBPath)

My first thought would be that it's not enough to just list a password in a comment. You should use it when opening the database.

Second thought:
OpenDatabase is a method of DAO.
DoCmd.TransferDatabase is a method of the Access object.
Both are fundamentally different accesses, which should be taken into account when transferring a password.

With this i can copy of non existance table, but non existance fields of existing table was unable to copy.

Sub UpdateTableStructure()
    Dim sourceDB As DAO.Database
    Dim destDB As DAO.Database
    Dim tblDef As DAO.TableDef
    
    ' Set the source and destination database paths and passwords
    Dim sourceDBPath As String
    Dim destDBPath As String
    Dim sourceDBPassword As String
    Dim destDBPassword As String
    
    sourceDBPath = CurrentProject.Path & "\structure\HardwareBE.accdb"
    destDBPath = CurrentProject.Path & "\HardwareBE.accdb"
    sourceDBPassword = "rmk3200125"
    destDBPassword = "rmk3200125"
    
    ' Open the source and destination databases
    Set sourceDB = OpenDatabase(sourceDBPath, False, False, ";PWD=" & sourceDBPassword)
    Set destDB = OpenDatabase(destDBPath, False, False, ";PWD=" & destDBPassword)
    
    ' Loop through tables in the source database
    For Each tblDef In sourceDB.TableDefs
        If Not TableExists(tblDef.Name, destDB) Then
            ' Create the table in the destination database with the same structure
            Dim newTblDef As DAO.TableDef
            Set newTblDef = destDB.CreateTableDef(tblDef.Name)
            
            ' Copy field structure from source table to destination table
            For Each fld In tblDef.Fields
                Dim newField As DAO.Field
                Set newField = newTblDef.CreateField(fld.Name, fld.Type)
                newField.Size = fld.Size
                newTblDef.Fields.Append newField
            Next fld
            
            ' Append the new table definition to the destination database
            destDB.TableDefs.Append newTblDef
            
            Else

            For Each fld In tblDef.Fields
            Dim fField As DAO.Field
            Dim iIndex As DAO.Index
            If Not FieldExists(fld.Name, tblDef.Name, destDB) = True Then
            Set fField = destDB.TableDefs(tblDef.Name).CreateField(fld.Name, fld.Type)

            fField.Attributes = fld.Attributes
            fField.Size = fld.Size
            fField.Required = fld.Required
            fField.DefaultValue = fld.DefaultValue
            tblDef.Fields.Append fField

            If fld.Attributes = 17 Then
            Set iIndex = tblDef.CreateIndex("PrimaryKey")
            iIndex.Primary = True
            iIndex.Required = True
            iIndex.Unique = True
            Set fField = iIndex.CreateField(fld.Name)
            iIndex.Fields.Append fField
            tblDef.Indexes.Append iIndex
            End If
            End If
            Next fld

        End If
    Next tblDef
    
    ' Close the databases
    sourceDB.Close
    destDB.Close
    Set sourceDB = Nothing
    Set destDB = Nothing
    
    MsgBox "Table structure update complete!", vbInformation
End Sub

Function TableExists(tableName As String, db As DAO.Database) As Boolean
    On Error Resume Next
    TableExists = Not (db.TableDefs(tableName) Is Nothing)
    On Error GoTo 0
End Function

Function FieldExists(fieldName As String, tbl As String, db As DAO.Database) As Boolean
    On Error Resume Next
    FieldExists = Not (db.TableDefs(tbl).Fields(fieldName) Is Nothing)
    On Error GoTo 0
End Function