Access 97: VBA-DAO-Access 97 synchronization problem?
I have an interesting problem...
I have created a translation routine to import records from an old dBase
file into a temporary table in the currently open Access 97 database. The
routine allows the user to select the dBase file to import, verifies the
table structure, creates a new table in the current database and adds the
records. Everything works beautifully. This routine is called by the Open
routine of a form.
The problem is that when the form attempts to attach to the newly-created
table sometimes it finds it, but most of the time it doesn't. It displays
an error message that it can't find the table, then breaks out to the Debug
window. If I simply tell it to continue with the line that caused the
error, it ALWAYS finds the table. All I can think is that Win95 is caching
the disk writes and Access isn't reading the cached information when it
goes to attach to the table. I've tried everything and then some. I know
it is not technically possible to try more than everything, but it feels
that way :)
Is there a bug in the communications between Access 97 and the Jet 3.5
database engine? Has anyone else experienced this? Can anyone HELP!????
T.I.A.,
Bill
----THE CODE----
---IN FORM CODE MODULE---
--FORM OPEN EVENT--
Private Sub Form_Open(Cancel As Integer)
If Main.ImportInventory() < 1 Then
Cancel = True
Exit Sub
End If
Me.RecordSource = "Imported Inventory Items"
End Sub
---IN MAIN MODULE---
Function ImportInventory()
Dim blnAllIsWell As Boolean
Dim dbsNew As Database
Dim dbsOld As Database
Dim fldField As Field
Dim fldLoop As Field
Dim msaof As MSA_OPENFILENAME
Dim rstImportedInventoryItems As Recordset
Dim rstOld As Recordset
Dim tdfImportedInventoryItems As TableDef
'Set default return argument to -1 (error or cancel)
ImportInventory = -1
' Display the Open dialog box for the user to locate the dBase database.
' Set options for the dialog box.
msaof.lngFlags = OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST
msaof.strDialogTitle = "Locate dBase file to import data from."
msaof.strInitialDir = ""
msaof.strInitialFile = "*.dbf"
msaof.strFilter = MSA_CreateFilterString("dBase Database" _
& "Files (*.dbf)", "*.dbf")
' Call the Open dialog routine.
MSA_GetOpenFileName msaof
'Allow time for the screen to repaint itself
DoEvents
'Exit if user pressed Cancel or selected nothing
If Trim(msaof.strFullPathReturned) = "" Then Exit Function
'Create a new Database object and connect it to the selected dBase
database file
Set dbsOld = OpenDatabase(Mid$(msaof.strFullPathReturned, 1, _
msaof.intFileOffset), False, True, "dBASE III;")
Set rstOld = dbsOld.OpenRecordset( _
Trim$(msaof.strFileNameReturned))
'Make sure there's at least one record in the file
If rstOld.BOF Then
dbsOld.Close
MsgBox "There are no records to import!", vbExclamation
Exit Function
End If
'Move to the first record in the file
rstOld.MoveFirst
'Make sure all the appropriate fields exist!
blnAllIsWell = True
If Not IsInFieldsCollection(rstOld, "NSN") Or _
Not IsInFieldsCollection(rstOld, "NSN2") Or _
Not IsInFieldsCollection(rstOld, "NOMENCLATU") Or _
Not IsInFieldsCollection(rstOld, "LOCATION") Or _
Not IsInFieldsCollection(rstOld, "REMARKS") Or _
Not IsInFieldsCollection(rstOld, "QTYOH") Or _
Not IsInFieldsCollection(rstOld, "UI") Or _
Not IsInFieldsCollection(rstOld, "STOCKLEV") Then _
blnAllIsWell = False
If blnAllIsWell = False Then
dbsOld.Close
MsgBox "Can't import from selected .dbf because" & vbCrLf & _
"it is missing one or more fields!", vbExclamation
Exit Function
End If
'Make sure the fields have the correct definitions
With rstOld
If !NSN.Type <> dbText Or !NSN.Size <> 4 Or _
!NSN2.Type <> dbText Or !NSN2.Size <> 14 Or _
!NOMENCLATU.Type <> dbText Or !NOMENCLATU.Size <> 100 Or _
!Location.Type <> dbText Or !Location.Size <> 100 Or _
!Remarks.Type <> dbText Or !Remarks.Size <> 250 Or _
!QTYOH.Type <> dbDouble Or !QTYOH.Size <> 8 Or _
!UI.Type <> dbText Or !UI.Size <> 2 Or _
!STOCKLEV.Type <> dbDouble Or !STOCKLEV.Size <> 8 Then _
blnAllIsWell = False
End With
If blnAllIsWell = False Then
dbsOld.Close
MsgBox "Can't import from selected .dbf because" & vbCrLf & _
"the type and/or size of one or more" & vbCrLf & _
"fields is incorrect!", vbExclamation
Exit Function
End If
'Create "Imported Inventory Items" table
'Set up a variable to connect to the MSAccess database
Set dbsNew = CurrentDb
'Create "Imported Inventory Items" table copying attributes from
'"Inventory Items" table
Set tdfImportedInventoryItems = dbsNew.CreateTableDef( _
"Imported Inventory Items", _
dbsNew![Inventory Items].Attributes, "Inventory Items")
'Create a new field for the user to specify if this is a record to
'keep.
Set fldField = tdfImportedInventoryItems.CreateField("Keep", dbBoolean)
'Set the properties of the Keep field
fldField.Required = True
fldField.DefaultValue = True
'Add the Keep field to the table
tdfImportedInventoryItems.Fields.Append fldField
'Copy the remaining fields from the "Inventory Items" table
For Each fldLoop In dbsNew![Inventory Items].Fields
tdfImportedInventoryItems.Fields.Append _
tdfImportedInventoryItems.CreateField(fldLoop.Name, _
fldLoop.Type, fldLoop.Size)
Next
'Add "Imported Inventory Items" table to database
dbsNew.TableDefs.Append tdfImportedInventoryItems
Application.RefreshDatabaseWindow
'Create a recordset variable to access the new table
Set rstImportedInventoryItems =
tdfImportedInventoryItems.OpenRecordset()
'Add non-blank dBase records to "Imported Inventory Items" table
rstOld.MoveFirst
Do
blnAllIsWell = True
With rstOld
If IsNull(!NSN) And IsNull(!NSN2) And IsNull(!NOMENCLATU) Then
_
blnAllIsWell = False
End With
If blnAllIsWell = True Then
With rstImportedInventoryItems
.AddNew
!NSN = rstOld!NSN & rstOld!NSN2
!Nomenclature = rstOld!NOMENCLATU
!Location = rstOld!Location
![Unit of Issue] = rstOld!UI
If IsNull(![Unit of Issue]) Then ![Unit of Issue] = "EA"
!Remarks = rstOld!Remarks
![Restock Level] = rstOld!STOCKLEV
If ![Restock Level] < 0 Then ![Restock Level] = Null
![Quantity on Hand] = 0
If rstOld!QTYOH > 0 Then _
![Quantity on Hand] = rstOld!QTYOH
.Update
End With
End If
rstOld.MoveNext
Loop Until rstOld.EOF
'Close dBase database
dbsOld.Close
'Set return value to number of records copied
ImportInventory = rstImportedInventoryItems.RecordCount
'If no records were added...
If rstImportedInventoryItems.RecordCount < 1 Then
'Close the "Imported Inventory Items" recordset...
rstImportedInventoryItems.Close
'delete the "Imported Inventory Items" table
dbsNew.TableDefs.Delete "Imported Inventory Items"
'and of course notify the user.
MsgBox "There are no records to import!", vbExclamation
Else 'otherwise
'just close the "Imported Inventory Items" recordset
rstImportedInventoryItems.Close
End If
'Refresh the TableDefs collection or the form can't read the table
dbsNew.TableDefs.Refresh
End Function
