VB6 – Copying a table from MDB files
I needed to create a temp mdb file and copy a table and it’s data from another mdb file. After about 2 hours searching Google… I finally found several snippets of code I was able to piece together.
This doesn’t require ADOX or Access References (as recommended by about 90% of the shit I wadded through this afternoon) – this is just DAO.
One more thing.. I didn’t write this… I just arranged it. So.. a big thanks to those who did!! Copy and paste the purple code into a module and call it with the MakeTempDatabase command.
Sub MakeTempDatabase()
Dim db_name As String
On Error GoTo EH:
‘ Get the database name.
db_name = App.path
If Right$(db_name, 1) <> "\" Then db_name = db_name & "\"
db_name = db_name & "data.mdb"
szPAGES_LOCAL_DB = db_name
‘ Create the database.
Set db = DBEngine.CreateDatabase(db_name, dbLangGeneral)
db.Close
Set db = Nothing
Dim dbsource As dao.Database
Dim dbdest As dao.Database
Dim nRet As Integer
Set dbsource = OpenDatabase(“C:\FromData.mdb”, False, False, ";pwd=" & PASSWORD_VAR)
Set dbdest = OpenDatabase(db_name, True, False)
‘MAKE SURE TO REPLACE THE SourceTableName AND DestTableName WITH THE REAL TABLE NAME!!
nRet = CopyStruct(dbsource, dbdest, "SourceTableName", "DestTableName", True)
‘MAKE SURE TO REPLACE THE SourceTableName AND DestTableName WITH THE REAL TABLE NAME!!
nRet = CopyData(dbsource, dbdest, "SourceTableName", "DestTableName")
dbsource.Close
dbdest.Close
Exit Sub
EH:
End Sub
Function CopyStruct(from_db As dao.Database, to_db As dao.Database, from_nm As String, to_nm As String, create_ind As Integer) As Integer
On Error GoTo CSErr
Dim i As Integer
Dim tbl As New dao.TableDef ‘table object
Dim fld As dao.Field ‘field object
Dim ind As dao.Index ‘index object
‘Search to see if the table exists:
namesearch:
For i = 0 To to_db.TableDefs.Count – 1
If UCase(to_db.TableDefs(i).Name) = UCase(to_nm) Then
If MsgBox(to_nm + " already exists, delete it?", 4) = vbYes Then
‘to_db.TableDefs.Delete to_db.TableDefs(to_nm)
Else
to_nm = InputBox("Enter New Table Name:")
If to_nm = "" Then
Exit Function
Else
GoTo namesearch
End If
End If
Exit For
End If
Next
‘Strip off owner if necessary:
If InStr(to_nm, ".") <> 0 Then
to_nm = mID(to_nm, InStr(to_nm, ".") + 1, Len(to_nm))
End If
tbl.Name = to_nm
‘Create the fields:
For i = 0 To from_db.TableDefs(from_nm).Fields.Count – 1
Set fld = New Field
fld.Name = from_db.TableDefs(from_nm).Fields(i).Name
fld.Type = from_db.TableDefs(from_nm).Fields(i).Type
fld.Size = from_db.TableDefs(from_nm).Fields(i).Size
fld.Attributes = from_db.TableDefs(from_nm).Fields(i).Attributes
fld.AllowZeroLength = from_db.TableDefs(from_nm).Fields(i).AllowZeroLength
tbl.Fields.Append fld
Next
‘Append the new table:
to_db.TableDefs.Append tbl
CopyStruct = True
GoTo CSEnd
CSErr:
If Err.Number = 3219 Then
Resume Next
End If
CopyStruct = False
Resume CSEnd
CSEnd:
End Function
Function CopyData(from_db As dao.Database, to_db As dao.Database, from_nm As String, to_nm As String) As Integer
On Error GoTo CopyErr
Dim ds1 As Dynaset, ds2 As Dynaset
Dim i As Integer
Set ds1 = from_db.CreateDynaset(from_nm)
Set ds2 = to_db.CreateDynaset(to_nm)
While ds1.EOF = False
ds2.AddNew
For i = 0 To ds1.Fields.Count – 1
ds2(i) = ds1(i)
Next
ds2.Update
ds1.MoveNext
Wend
CopyData = True
GoTo CopyEnd
CopyErr:
CopyData = False
Resume CopyEnd
CopyEnd:
End Function
–=–