Copying select records from external database to current database.

[CardinalBags]

I am upgrading databases often so I wrote some code to automate the process. In my latest round of updates, I am taking a subset of data from an existing table in my old database and copying it into its own table in the new database structure. Code is attached. Where I am having trouble is in the definition of the fields in the old database which is referenced using dbs1, the recordset is referenced as rst1. Since the old database is not open when compiling, it is returning Member not found inside of the For next loop involving ChangeID. I thought since I opened the old database using the line Set dbs1 = wsp.OpenDatabase(strInputFileName), then opening my table1 using the line Set rst1 = dbs1.OpenRecordset("Table1", dbOpenTable, dbReadOnly) this method would work, but I am thinking now, some other method must be used. I am a very new VBA programmer, I do not understand the use of ADODB.recorset usage, etc.

Public Sub GetOldData()
On Erro GoTo Err_GetOldData

Dim InputFile As Variant
Dim dbs As Database
Dim dbs1 As Database
Dim wsp As Workspace
Dim rst As Recordset
Dim rst1 As Recordset
Dim strInputFileName As String
Dim strFilter As String
Dim SQLString1 As String
Dim SQLString2 As String
Dim SQLString3 As String
Dim SQLString4 As String
Dim SQLString5 As String
Dim FieldID1 As Field
Dim FieldID2 As Field
Dim FieldID3 As Field
Dim ChangeID As Integer

strInputFileName = CurrentDb.Name

While GetShortName(CurrentDb.Name) = GetShortName(strInputFileName)
strFilter = ahtAddFilterItem(strFilter, "Access Files (*.MDB, *.accdb)", "*.MDB; *.accdb")
strInputFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=True, _
DialogTitle:="Please select the old file to upgrade from...", _
Flags:=ahtOFN_HIDEREADONLY)

If (GetShortName(CurrentDb.Name) = GetShortName(strInputFileName)) Then
MsgBox "This Database is already open. Please pick another..."
End If
Wend

If strInputFileName = "" Then
MsgBox "Import Cancelled by User"
Else

Set dbs = CurrentDb

Set wsp = DBEngine.Workspaces(0)

Set dbs1 = wsp.OpenDatabase(strInputFileName)

If (DoesTblExist(dbs1, "Engineering") And DoesTblExist(dbs1, "Followups") And DoesTblExist(dbs1, "SummaryData") And _
DoesTblExist(dbs1, "Table1") And DoesTblExist(dbs1, "Personnel")) Then

DoCmd.SetWarnings (0)
DoCmd.TransferDatabase acImport, "Microsoft Access", strInputFileName, acTable, "Engineering", "Engineering1"
DoCmd.TransferDatabase acImport, "Microsoft Access", strInputFileName, acTable, "Followups", "Followups1"
DoCmd.TransferDatabase acImport, "Microsoft Access", strInputFileName, acTable, "Personnel", "Personnel1"
DoCmd.TransferDatabase acImport, "Microsoft Access", strInputFileName, acTable, "SummaryData", "SummaryData1"
DoCmd.TransferDatabase acImport, "Microsoft Access", strInputFileName, acTable, "Table1", "Table11"

SQLString1 = "INSERT INTO Engineering Select * FROM Engineering1;"
SQLString2 = "INSERT INTO Followups Select * FROM Followups1;"
SQLString3 = "INSERT INTO Personnel Select * FROM Personnel1;"
SQLString4 = "INSERT INTO SummaryData Select * FROM SummaryData1;"
SQLString5 = "INSERT INTO Table1 Select * FROM Table11;"

DoCmd.RunSQL SQLString1
DoCmd.RunSQL SQLString2
DoCmd.RunSQL SQLString3
DoCmd.RunSQL SQLString4
DoCmd.RunSQL SQLString5

DoCmd.DeleteObject acTable, "Engineering1"
DoCmd.DeleteObject acTable, "Followups1"
DoCmd.DeleteObject acTable, "Personnel1"
DoCmd.DeleteObject acTable, "SummaryData1"
DoCmd.DeleteObject acTable, "Table11"

DoCmd.SetWarnings (1)

MsgBox "Finished importing data. Check the data to ensure accuracy.", vbOKOnly

Else
MsgBox "Operation NOT Completed: Proper Table Structure does not exist in this file!", vbCritical
End If

If (DoesTblExist(dbs1, "ScopeChanges")) Then

DoCmd.SetWarnings (0)
DoCmd.TransferDatabase acImport, "Microsoft Access", strInputFileName, acTable, "ScopeChanges", "ScopeChanges1"
SQLString1 = "INSERT INTO ScopeChanges Select * FROM ScopeChanges1;"
DoCmd.RunSQL SQLString1
DoCmd.DeleteObject acTable, "ScopeChanges1"
DoCmd.SetWarnings (1)

MsgBox "Finished importing data. Check the data to ensure accuracy.", vbOKOnly

Else
Set rst = dbs.OpenRecordset("ScopeChanges", dbOpenTable, dbConsistent)
Set rst1 = dbs1.OpenRecordset("Table1", dbOpenTable, dbReadOnly)

rst.MoveFirst
rst1.MoveFirst

While rst.EOF = False

FieldID3 = "Item"

For ChangeID = 1 To 7

FieldID1 = "ScopeChange" & ChangeID
FieldID2 = "ScopeChange" & ChangeID & "Date"

If IsNull(rst1.FieldID1) = False Then ' <--- this is where it all falls down!
rst.AddNew
rst.Item = rst1.FieldID3
rst.ScopeChangeDesc = rst1.FieldID1
rst.ScopeChangeDate = rst1.FieldID2
rst.Update
End If
Next

rst1.MoveNext

Wend

MsgBox "Finished importing data. Check the data to ensure accuracy.", vbOKOnly

End If


dbs1.Close

Forms!Switchboard.Filter = "[ItemNumber] = 0 " & "And [SwitchboardID] = 1"
Forms!Switchboard.Refresh

End If

Exit_GetOldData:
Exit Sub

Err_GetOldData:
MsgBox Err.Description
Resume Exit_GetOldData

End Sub

 

[SkipVought]

hi,

What application?

if MS Access then you will get better results in forum705.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[PHV]

What about this ?

...
                       If IsNull(rst1[!]([/!]FieldID1[!])[/!]) = False Then
                            rst.AddNew
                            rst.Item = rst1[!]([/!]FieldID3[!])[/!]
                            rst.ScopeChangeDesc = rst1[!]([/!]FieldID1[!])[/!]
                            rst.ScopeChangeDate = rst1[!]([/!]FieldID2[!])[/!]
                            rst.Update
                        End If
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[CardinalBags]

Yes. It was just that simple. Thanks!