Run time error 3251 after splitting DB 1

[sterlecki]

The following code worked great until I split the database to an Access FE/BE.

Code hangs at highlight in debugger

Is it because the:
Set DB = currentDb is no longer correct ?
or something else I need to do.

Private Sub cmd_AddDistributionEmails_Click()

Dim API As String

'Check to make sure proper API is selected

If Forms![Main Form]!cbo_SelectWell = "" Then
MsgBox ("You Must Select a Well To Add a Well Contact")
Exit Sub
End If

'Check to make sure Wells are selected
If IsNull(Forms![Main Form]!cbo_SelectWell) Or Forms![Main Form]!cbo_SelectWell = "" Then
MsgBox ("You Must Select a Well To Add a Well Contact")
Exit Sub
Else
API = Forms![Main Form]!cbo_SelectWell.Column(0)
End If


'Get Ready to Insert Recordsnz

    Dim DB As DAO.Database
    Dim rs As DAO.Recordset
    
    'Start code to add records to "data_WellContacts"
Dim item As Integer
Dim Cri, LBx As ListBox, itm, Build As String, DQ As String
   
   Set LBx = Forms![Main Form]![lst_SelectDistributionEmails]
   Set DB = CurrentDb
   Set rs = DB.OpenRecordset("data_DistributionEmails")
       
  

   
   With rs
        
        For Each itm In LBx.ItemsSelected
        
        [highlight].Index = "PrimaryKey"[/highlight]
        .Seek "=", LBx.Column(0, itm), API
        
  If rs.NoMatch Then
        .AddNew
        !API = API
        !DistributionEmail_ID = LBx.Column(0, itm)
        !Name = LBx.Column(1, itm)
        !Email = LBx.Column(2, itm)
        !CompanyName = LBx.Column(3, itm)
        !DateCreated = Now()
        !UserCreated = fOSUserName()
        .Update
        .Bookmark = rs.LastModified
    Else
         MsgBox "API='" & API _
            & "' ContactName = '" & LBx.Column(2, itm) _
            & "' Previously entered record"
    End If
    Next
    End With
    rs.Close
    Me.Refresh
    Forms![Main Form]![Frm_DistributionEmails].Form.Requery

'
Exit_cmd_AddDistributionEmails_Click:
    Set DB = Nothing
    Exit Sub

Err_cmd_AddDistributionEmails_Click:
    MsgBox Err.Description
    


    
    Resume Exit_cmd_AddDistributionEmails_Click
End Sub

 

[MajP]

You can't use the Seek method on a linked table because you can't open linked tables as table-type Recordset objects.

Use findfirst instead

 

[sterlecki]

Thanks MajP you may have a better approach that I should test but for now I got it to work by adding the highlighted modifications.

If you have any suggestions for improvement they would be welcome.

Private Sub cmd_AddWellDataDistributionContact_Click()

On Error GoTo Err_cmdAddWellDataDistributionContact_Click

Dim API As String

'Check to make sure proper API is selected

If Forms![Main Form]!cbo_SelectWell = "" Then
MsgBox ("You Must Select a Well To Add a Well Data Distribution Contact")
Exit Sub
End If

'Check to make sure Wells are selected
If IsNull(Forms![Main Form]!cbo_SelectWell) Or Forms![Main Form]!cbo_SelectWell = "" Then
MsgBox ("You Must Select a Well To Add a Well Data Distribution Contact")
Exit Sub
Else
API = Forms![Main Form]!cbo_SelectWell.Column(0)
End If


'Get Ready to Insert Recordsnz
    [highlight]Dim ac As Object
    Set ac = CreateObject("Access.Application")[/highlight]
    Dim DB As DAO.Database
    Dim rs As DAO.Recordset
    
    

'Start code to add records to "data_WellContacts"

Dim item As Integer
Dim Cri, LBx As ListBox, itm, Build As String, DQ As String
   
   Set LBx = Forms![Main Form]![lst_WellDataDistribution]
   [highlight]ac.OpenCurrentDatabase ("U:\Pinedale Exchange\PROGS\Questar Geologic Prognosis Application\SWT_Development folder\UpdatedQuestarGeologicPrognosis_be.accdb")
   
   'Set DB = CurrentDb
   Set DB = ac.CurrentDb()[/highlight]
   Set rs = DB.OpenRecordset("data_WellDataDistribution")
       
  

   
   With rs
        
        For Each itm In LBx.ItemsSelected
        
        .Index = "PrimaryKey"
        .Seek "=", LBx.Column(0, itm), API
        
  If rs.NoMatch Then
        .AddNew
        !API = API
        !ContactID = LBx.Column(0, itm)
        !CompanyName = LBx.Column(1, itm)
        !CompanyAddress = LBx.Column(2, itm)
        !CompanyAddress2 = LBx.Column(3, itm)
        !CompanyCity = LBx.Column(4, itm)
        !CompanyState = LBx.Column(5, itm)
        !CompanyZipCode = LBx.Column(6, itm)
        !ContactType = LBx.Column(7, itm)
        !ContactPosition = LBx.Column(8, itm)
        !ContactName = LBx.Column(9, itm)
        !ContactInitials = LBx.Column(10, itm)
        !ContactWorkPhone = LBx.Column(11, itm)
        !ContactCellPhone = LBx.Column(12, itm)
        !ContactHomePhone = LBx.Column(13, itm)
        !ContactFax = LBx.Column(14, itm)
        !ContactEmail = LBx.Column(15, itm)
        !OperationsGroup = LBx.Column(16, itm)
        !DateCreated = Now()
        !UserCreated = fOSUserName()
        .Update
        .Bookmark = rs.LastModified
    Else
         MsgBox "API='" & API _
            & "' ContactName = '" & LBx.Column(9, itm) _
            & "' Previously entered record"
    End If
    Next
    End With
    rs.Close
    Me.Refresh
    [highlight]DB.Close[/highlight]
    '**************Forms![Main Form]![Frm_wellcontacts Subform].Form.Requery

'
Exit_cmdAddWellDataDistributionContact_Click:
    Set DB = Nothing
    Exit Sub

Err_cmdAddWellDataDistributionContact_Click:
    MsgBox Err.Description
    

    
    Resume Exit_cmdAddWellDataDistributionContact_Click

End Sub

 

[MajP]

Yes that is correct
if you use the OpenDatabase method to directly open an installable (non-ODBC) database, you can use Seek on tables in that database.
I have never seen it done that way, but you have it working.

Seems like a lot of work. Like I said you can simply use use the findfirst.

Set rs = currentDb.OpenRecordset("data_WellDataDistribution")

For Each itm In LBx.ItemsSelected
rs.findFirst "ContactID = " & LBx.Column(0, itm)
If rs.NoMatch Then
.........

 

[sterlecki]

Thanks I'll try that. The DB was responding kind of slow so maybe your method will speed things up. A star for you.