Splitting Database

D

Doug Maki

I am currently looking into splitting our database. We
supply this database to various Ambulance services
including our own. We wrote it here because most of our
rural departments cannot afford to purchase computerized
report/billing system. However we have 2 versions one is
Office where all the billing and statistical reports are
done and the other is a field version. Has only what is
necessary to complete an ambulance report. The reports
are transfered by code from the data entry version into
the Office versions but I get run time error 3251.
Operation is not supported for this type of object. Here
is the code and I put a * next to where the debugger
stopped. This code has worked fine until I split the
databases. What do I need to change to make it work now
that they are split.


Private Sub cmdTransfer_Click()

Dim frndb As Database, db As Database
Dim rec As Recordset, rst As Recordset
Dim vardrive As String
Dim suma As Integer, sumb As Integer

MsgBox "Select appropriate program to get patient
data from."

Me.dlgCommon.ShowOpen
vardrive = Me.dlgCommon.filename

Set db = CurrentDb()
Set frndb = OpenDatabase(vardrive,
dbDriverPrompt, False, ";UserID=Transfer;PWD=549")
Set rec = frndb.OpenRecordset("tblPatients")
Set rst = db.OpenRecordset("tblPatients")


If rec.BOF = True Then
MsgBox "No Records To Transfer"
Exit Sub
Else
End If
suma = rst.RecordCount
rec.MoveFirst
MsgBox "Checking and Transferring new Patient
Data!"
Do Until rec.EOF
* rst.Index = "PrimaryKey"
rst.Seek "=", rec![SSN]
If rst.NoMatch Then
With rst
.AddNew
![SSN] = rec![SSN]
!LastName = rec!LastName
!FirstName = rec!FirstName
!MidInit = rec![MidInit]
![StreetAddress] = rec![StreetAddress]
!City = rec!City
!CityCode = rec!CityCode
!County = rec!County
!CountyCode = rec!CountyCode
!State = rec!State
!Zip = rec![Zip]
![AreaCode] = rec![AreaCode]
!Phone = rec!Phone
![BirthDate] = rec![BirthDate]
!Age = rec!Age
!NationalOrigin = rec!NationalOrigin
!Sex = rec!Sex
![MaritalStatus] = rec![MaritalStatus]
![EmploymentStatus] = rec![EmploymentStatus]
!Weight = rec!Weight
!Resident = rec!Resident
![GuarantorSSN] = rec![GuarantorSSN]
![LnameGuarantor] = rec![LnameGuarantor]
![FnameGuarantor] = rec![FnameGuarantor]
![MidInitGuarantor] = rec![MidInitGuarantor]
![AddressGuarantor] = rec![AddressGuarantor]
![CityGuarantor] = rec![CityGuarantor]
![StateGuarantor] = rec![StateGuarantor]
![ZipGuarantor] = rec![ZipGuarantor]
![ACGuarantor] = rec![ACGuarantor]
![PhoneGuarantor] = rec![PhoneGuarantor]
!Relationship = rec!Relationship
![GuarantorSex] = rec![GuarantorSex]
![InsuranceClass] = rec![InsuranceClass]
![InsuranceCompany] = rec![InsuranceCompany]
![GroupNumber] = rec![GroupNumber]
![PolicyNumber] = rec![PolicyNumber]
![MedicareNmbr] = rec![MedicareNmbr]
![MedicareState] = rec![MedicareState]
![MedicaidNmbr] = rec![MedicaidNmbr]
![MedicaidState] = rec![MedicaidState]
![PatientEmployer] = rec![PatientEmployer]
![GuarantorEmployer] = rec![GuarantorEmployer]
![InsuredIDNumber] = rec![InsuredIDNumber]
![PrimaryInsuranceCo] = rec!PrimaryInsuranceCo]
![PrimaryGroupNumber] = rec[PrimaryGroupNumber]
![SecondaryInsurance] = rec[SecondaryInsurance]
![SecondaryGroupNumber] = rec[SecondaryGroupNumber]
![OtherInsurance] = rec![OtherInsurance]
![OtherGroupNumber] = rec![OtherGroupNumber]
![GuarantorBirthDate] = rec![GuarantorBirthDate]

rst.Update
rec.MoveNext
'Once one set of records are transfered,
repeats until all are done. Unlike
'the transfer of the other records, there is
supposed to be duplicates so
'this procedure transfers all but the
duplicates.
End With
Else
rec.MoveNext
End If

Loop
sumb = rst.RecordCount
sumb = sumb - suma
MsgBox sumb & " New Patient Data Transfered!"
GoTo cmdUploadPtData_Click_Exit:
'Closes the connection to the other database and sets
the variable values to
' Nothing. The next step in the transfer is than
started.
cmdUploadPtData_Click_Exit:

rst.Close
rec.Close
frndb.Close
Set rst = Nothing
Set rec = Nothing
Set frndb = Nothing

Call MARFTransfer(vardrive)
End Sub
 
T

Tom Wickerath

Hi Doug,

I think your code is failing with the Seek method. See the following Microsoft KB article:

How to Use the Seek Method on Linked Tables
http://support.microsoft.com/?id=210266

Also, I recommend that you explicitly declare your recordsets as DAO recordsets. It won't help
with your current problem, but it will help prevent any future problems with library priority.
Currently, your code will fail if you have a reference for ADO (Microsoft ActiveX Data Objects
2.x Library) selected, and it is higher in the list than your reference to DAO. The change I am
suggesting is:

From
Dim rec As Recordset, rst As Recordset

To
Dim rec As DAO.Recordset, rst As DAO.Recordset


Tom
_____________________________________________


I am currently looking into splitting our database. We
supply this database to various Ambulance services
including our own. We wrote it here because most of our
rural departments cannot afford to purchase computerized
report/billing system. However we have 2 versions one is
Office where all the billing and statistical reports are
done and the other is a field version. Has only what is
necessary to complete an ambulance report. The reports
are transfered by code from the data entry version into
the Office versions but I get run time error 3251.
Operation is not supported for this type of object. Here
is the code and I put a * next to where the debugger
stopped. This code has worked fine until I split the
databases. What do I need to change to make it work now
that they are split.


Private Sub cmdTransfer_Click()

Dim frndb As Database, db As Database
Dim rec As Recordset, rst As Recordset
Dim vardrive As String
Dim suma As Integer, sumb As Integer

MsgBox "Select appropriate program to get patient
data from."

Me.dlgCommon.ShowOpen
vardrive = Me.dlgCommon.filename

Set db = CurrentDb()
Set frndb = OpenDatabase(vardrive,
dbDriverPrompt, False, ";UserID=Transfer;PWD=549")
Set rec = frndb.OpenRecordset("tblPatients")
Set rst = db.OpenRecordset("tblPatients")


If rec.BOF = True Then
MsgBox "No Records To Transfer"
Exit Sub
Else
End If
suma = rst.RecordCount
rec.MoveFirst
MsgBox "Checking and Transferring new Patient
Data!"
Do Until rec.EOF
* rst.Index = "PrimaryKey"
rst.Seek "=", rec![SSN]
If rst.NoMatch Then
With rst
.AddNew
![SSN] = rec![SSN]
!LastName = rec!LastName
!FirstName = rec!FirstName
!MidInit = rec![MidInit]
![StreetAddress] = rec![StreetAddress]
!City = rec!City
!CityCode = rec!CityCode
!County = rec!County
!CountyCode = rec!CountyCode
!State = rec!State
!Zip = rec![Zip]
![AreaCode] = rec![AreaCode]
!Phone = rec!Phone
![BirthDate] = rec![BirthDate]
!Age = rec!Age
!NationalOrigin = rec!NationalOrigin
!Sex = rec!Sex
![MaritalStatus] = rec![MaritalStatus]
![EmploymentStatus] = rec![EmploymentStatus]
!Weight = rec!Weight
!Resident = rec!Resident
![GuarantorSSN] = rec![GuarantorSSN]
![LnameGuarantor] = rec![LnameGuarantor]
![FnameGuarantor] = rec![FnameGuarantor]
![MidInitGuarantor] = rec![MidInitGuarantor]
![AddressGuarantor] = rec![AddressGuarantor]
![CityGuarantor] = rec![CityGuarantor]
![StateGuarantor] = rec![StateGuarantor]
![ZipGuarantor] = rec![ZipGuarantor]
![ACGuarantor] = rec![ACGuarantor]
![PhoneGuarantor] = rec![PhoneGuarantor]
!Relationship = rec!Relationship
![GuarantorSex] = rec![GuarantorSex]
![InsuranceClass] = rec![InsuranceClass]
![InsuranceCompany] = rec![InsuranceCompany]
![GroupNumber] = rec![GroupNumber]
![PolicyNumber] = rec![PolicyNumber]
![MedicareNmbr] = rec![MedicareNmbr]
![MedicareState] = rec![MedicareState]
![MedicaidNmbr] = rec![MedicaidNmbr]
![MedicaidState] = rec![MedicaidState]
![PatientEmployer] = rec![PatientEmployer]
![GuarantorEmployer] = rec![GuarantorEmployer]
![InsuredIDNumber] = rec![InsuredIDNumber]
![PrimaryInsuranceCo] = rec!PrimaryInsuranceCo]
![PrimaryGroupNumber] = rec[PrimaryGroupNumber]
![SecondaryInsurance] = rec[SecondaryInsurance]
![SecondaryGroupNumber] = rec[SecondaryGroupNumber]
![OtherInsurance] = rec![OtherInsurance]
![OtherGroupNumber] = rec![OtherGroupNumber]
![GuarantorBirthDate] = rec![GuarantorBirthDate]

rst.Update
rec.MoveNext
'Once one set of records are transfered,
repeats until all are done. Unlike
'the transfer of the other records, there is
supposed to be duplicates so
'this procedure transfers all but the
duplicates.
End With
Else
rec.MoveNext
End If

Loop
sumb = rst.RecordCount
sumb = sumb - suma
MsgBox sumb & " New Patient Data Transfered!"
GoTo cmdUploadPtData_Click_Exit:
'Closes the connection to the other database and sets
the variable values to
' Nothing. The next step in the transfer is than
started.
cmdUploadPtData_Click_Exit:

rst.Close
rec.Close
frndb.Close
Set rst = Nothing
Set rec = Nothing
Set frndb = Nothing

Call MARFTransfer(vardrive)
End Sub
 
D

Doug

Thank You for your help, and for the added input I have
had problems in the past with the order of my references
causing a fault I did not think to declare them as DAO
recordsets.
-----Original Message-----
Hi Doug,

I think your code is failing with the Seek method. See
Click to expand...
the following Microsoft KB article:
How to Use the Seek Method on Linked Tables
http://support.microsoft.com/?id=210266

Also, I recommend that you explicitly declare your
Click to expand...
recordsets as DAO recordsets. It won't help
with your current problem, but it will help prevent any
Click to expand...
future problems with library priority.
Currently, your code will fail if you have a reference
Click to expand...
for ADO (Microsoft ActiveX Data Objects
2.x Library) selected, and it is higher in the list than
Click to expand...
your reference to DAO. The change I am
suggesting is:

From
Dim rec As Recordset, rst As Recordset

To
Dim rec As DAO.Recordset, rst As DAO.Recordset


Tom
_____________________________________________


I am currently looking into splitting our database. We
supply this database to various Ambulance services
including our own. We wrote it here because most of our
rural departments cannot afford to purchase computerized
report/billing system. However we have 2 versions one is
Office where all the billing and statistical reports are
done and the other is a field version. Has only what is
necessary to complete an ambulance report. The reports
are transfered by code from the data entry version into
the Office versions but I get run time error 3251.
Operation is not supported for this type of object. Here
is the code and I put a * next to where the debugger
stopped. This code has worked fine until I split the
databases. What do I need to change to make it work now
that they are split.


Private Sub cmdTransfer_Click()

Dim frndb As Database, db As Database
Dim rec As Recordset, rst As Recordset
Dim vardrive As String
Dim suma As Integer, sumb As Integer

MsgBox "Select appropriate program to get patient
data from."

Me.dlgCommon.ShowOpen
vardrive = Me.dlgCommon.filename

Set db = CurrentDb()
Set frndb = OpenDatabase(vardrive,
dbDriverPrompt, False, ";UserID=Transfer;PWD=549")
Set rec = frndb.OpenRecordset("tblPatients")
Set rst = db.OpenRecordset("tblPatients")


If rec.BOF = True Then
MsgBox "No Records To Transfer"
Exit Sub
Else
End If
suma = rst.RecordCount
rec.MoveFirst
MsgBox "Checking and Transferring new Patient
Data!"
Do Until rec.EOF
* rst.Index = "PrimaryKey"
rst.Seek "=", rec![SSN]
If rst.NoMatch Then
With rst
.AddNew
![SSN] = rec![SSN]
!LastName = rec!LastName
!FirstName = rec!FirstName
!MidInit = rec![MidInit]
![StreetAddress] = rec![StreetAddress]
!City = rec!City
!CityCode = rec!CityCode
!County = rec!County
!CountyCode = rec!CountyCode
!State = rec!State
!Zip = rec![Zip]
![AreaCode] = rec![AreaCode]
!Phone = rec!Phone
![BirthDate] = rec![BirthDate]
!Age = rec!Age
!NationalOrigin = rec!NationalOrigin
!Sex = rec!Sex
![MaritalStatus] = rec![MaritalStatus]
![EmploymentStatus] = rec![EmploymentStatus]
!Weight = rec!Weight
!Resident = rec!Resident
![GuarantorSSN] = rec![GuarantorSSN]
![LnameGuarantor] = rec![LnameGuarantor]
![FnameGuarantor] = rec![FnameGuarantor]
![MidInitGuarantor] = rec![MidInitGuarantor]
![AddressGuarantor] = rec![AddressGuarantor]
![CityGuarantor] = rec![CityGuarantor]
![StateGuarantor] = rec![StateGuarantor]
![ZipGuarantor] = rec![ZipGuarantor]
![ACGuarantor] = rec![ACGuarantor]
![PhoneGuarantor] = rec![PhoneGuarantor]
!Relationship = rec!Relationship
![GuarantorSex] = rec![GuarantorSex]
![InsuranceClass] = rec![InsuranceClass]
![InsuranceCompany] = rec![InsuranceCompany]
![GroupNumber] = rec![GroupNumber]
![PolicyNumber] = rec![PolicyNumber]
![MedicareNmbr] = rec![MedicareNmbr]
![MedicareState] = rec![MedicareState]
![MedicaidNmbr] = rec![MedicaidNmbr]
![MedicaidState] = rec![MedicaidState]
![PatientEmployer] = rec![PatientEmployer]
![GuarantorEmployer] = rec! [GuarantorEmployer]
![InsuredIDNumber] = rec![InsuredIDNumber]
![PrimaryInsuranceCo] = rec! PrimaryInsuranceCo]
![PrimaryGroupNumber] = rec [PrimaryGroupNumber]
![SecondaryInsurance] = rec [SecondaryInsurance]
![SecondaryGroupNumber] = rec [SecondaryGroupNumber]
![OtherInsurance] = rec![OtherInsurance]
![OtherGroupNumber] = rec![OtherGroupNumber]
![GuarantorBirthDate] = rec! [GuarantorBirthDate]

rst.Update
rec.MoveNext
'Once one set of records are transfered,
repeats until all are done. Unlike
'the transfer of the other records, there is
supposed to be duplicates so
'this procedure transfers all but the
duplicates.
End With
Else
rec.MoveNext
End If

Loop
sumb = rst.RecordCount
sumb = sumb - suma
MsgBox sumb & " New Patient Data Transfered!"
GoTo cmdUploadPtData_Click_Exit:
'Closes the connection to the other database and sets
the variable values to
' Nothing. The next step in the transfer is than
started.
cmdUploadPtData_Click_Exit:

rst.Close
rec.Close
frndb.Close
Set rst = Nothing
Set rec = Nothing
Set frndb = Nothing

Call MARFTransfer(vardrive)
End Sub


.
Click to expand...
 
Top