Need to convert VBA recordset from Access table to SQL 1

[cdck]

I am working with a user who created an Access database to store document information; we are moving that information to our SQL server.

They created their project with a separate front and back ends, so that the data was stored in its own Access database. When we migrated the data to the SQL server and redirected the linked tables accordingly, everything worked fine with the exception of one function on an unbound form. This is the AfterUpdate event for one of the fields, which searches a table for a record matching the entry, and either fills in the rest of the form with the result or gives the user the opportunity to create a new record if none exists.

I have never worked with recordsets in VBA before, and so am confused as to why this doesn't work after the transition and how to fix it - any help would be appreciated.

Here is the original code, from when the project connected to the Access back end:
[tt]
Private Sub txtPartNumber_AfterUpdate()
On Error GoTo Err_txtPartNumber_AfterUpdate

Dim db As DAO.Database
Dim rstDocMaster As DAO.Recordset
Dim strDwgNo As String

strDwgNo = Me.cboPrefix.Value & Trim(Me.txtPartNumber.Value)
Set db = OpenDatabase("\\Ad1\ad13d\DocCtrl Database\DCDB_be\DocControlDB_be.mdb")
Set rstDocMaster = db.OpenRecordset("tblDocMaster")

rstDocMaster.Index = "PrimaryKey"
rstDocMaster.Seek "=", strDwgNo

' Check to see if drawing record already exists
If rstDocMaster.NoMatch Then
' If no match is found ask if user wants to add a new record
If MsgBox("Add as a new record?", vbYesNo + vbQuestion, "Part Number Does Not Exist") = vbYes Then
txtPartNumber.SetFocus

Else
' No record found and user does not want to enter as new
' Blank out entered information
cboPrefix.Value = Null
txtPartNumber = Null
Me.txtDwgNo = Null
cboPrefix.SetFocus

Exit Sub

End If

Else
' Record exists, show drawing information
txtTitle.Value = rstDocMaster!Title
txtMA.Value = rstDocMaster!MA
txtDwgSize.Value = rstDocMaster!DwgSize
txtSheetsNo.Value = rstDocMaster!SheetsNo
txtAssignedTo.Value = rstDocMaster!AssignedTo
txtAssignedDate.Value = rstDocMaster!AssignedDate
txtApprovedBy.Value = rstDocMaster!ApprovedBy
txtAprvdDate = rstDocMaster!AprvdDate
txtRev.Value = rstDocMaster!Rev
cboProdCode = rstDocMaster!ProdCode
'txtType.Requery
Me.txtDwgNo = strDwgNo
' Refresh Eco history for current drawing
sbfEcoHistory.Requery
' Show footer with clickable command button
Me.FormFooter.Visible = True
Me.cmdClearDwgInfo.SetFocus

End If

Exit_txtPartNumber_AfterUpdate:
Exit Sub

Err_txtPartNumber_AfterUpdate:
MsgBox Err.Description
Resume Exit_txtPartNumber_AfterUpdate

End Sub
[/tt]

Here is code that I tried:
[tt]
Private Sub txtPartNumber_AfterUpdate()
On Error GoTo Err_txtPartNumber_AfterUpdate

Dim strDwgNo As String
Dim rstDocMaster As ADODB.Recordset
Set rstDocMaster = New ADODB.Recordset



strDwgNo = Me.cboPrefix.Value & Trim(Me.txtPartNumber.Value)
rstDocMaster.Open ("Select * FROM tblDocMaster WHERE strDwgNo = " & strDwgNo & ";")


' Check to see if drawing record already exists
If rstDocMaster.EOF Then
'--------------------------------NO CHANGES BELOW HERE

' If no match is found ask if user wants to add a new record
If MsgBox("Add as a new record?", vbYesNo + vbQuestion, "Part Number Does Not Exist") = vbYes Then
txtPartNumber.SetFocus

Else
' No record found and user does not want to enter as new
' Blank out entered information
cboPrefix.Value = Null
txtPartNumber = Null
Me.txtDwgNo = Null
cboPrefix.SetFocus

Exit Sub

End If

Else
' Record exists, show drawing information
txtTitle.Value = rstDocMaster!Title
txtMA.Value = rstDocMaster!MA
txtDwgSize.Value = rstDocMaster!DwgSize
txtSheetsNo.Value = rstDocMaster!SheetsNo
txtAssignedTo.Value = rstDocMaster!AssignedTo
txtAssignedDate.Value = rstDocMaster!AssignedDate
txtApprovedBy.Value = rstDocMaster!ApprovedBy
txtAprvdDate = rstDocMaster!AprvdDate
txtRev.Value = rstDocMaster!Rev
cboProdCode = rstDocMaster!ProdCode
'txtType.Requery
Me.txtDwgNo = strDwgNo
' Refresh Eco history for current drawing
sbfEcoHistory.Requery
' Show footer with clickable command button
Me.FormFooter.Visible = True
Me.cmdClearDwgInfo.SetFocus

End If

Exit_txtPartNumber_AfterUpdate:
Exit Sub

Err_txtPartNumber_AfterUpdate:
MsgBox Err.Description
Resume Exit_txtPartNumber_AfterUpdate

End Sub
[/tt]

In both cases, when run, an error description comes up which states:
"The connection cannot be used to perform this operation. It is either closed or invalid in this context."

The error does not put me into debug, so I cannot tell exactly where it is thrown - but I assume that it's at the first effort to create the recordset.

Cheryl dc Kern

 

[Golom]

In ADO you require a connection to the database and I don't see one here which is what is giving you the error. You can find info on connecting to an SQL Server database here

Once you have one then you open an ADODB recordset with syntax of the form

rstDocMaster.Open SQL, [red]cn[/red]

Where [red]cn[/red] is an ADODB connection object that you have opened.

 

[dhookom]

This might work for you. You would be better off using pass-through queries and/or stored procedures with SQL Server.
[blue]Changed Code[/blue]
[Green]Added Code[/green]

Private Sub txtPartNumber_AfterUpdate()
On Error GoTo Err_txtPartNumber_AfterUpdate

    Dim db As DAO.Database
    [green]Dim strSQL as String [/green]
    Dim rstDocMaster As DAO.Recordset
    Dim strDwgNo As String

    strDwgNo = Me.cboPrefix.Value & Trim(Me.txtPartNumber.Value)
    [blue]Set db = Currentdb[/blue]
[green]    strSQL = "SELECT * FROM tblDocMaster WHERE [DwgNoFieldName]=""" & strDwgNo & """" [/green]
    [blue]Set rstDocMaster = db.OpenRecordset(strSQL)[/blue]        
    'rstDocMaster.Index = "PrimaryKey"  'COMMENTED OUT
    'rstDocMaster.Seek "=", strDwgNo    'COMMENTED OUT
    
    ' Check to see if drawing record already exists
    [blue]If rstDocMaster.EOF and rstDocMaster.BOF Then[/blue]
        ' If no match is found ask if user wants to add a new record
        If MsgBox("Add as a new record?", vbYesNo + vbQuestion, "Part Number Does Not Exist") = vbYes Then
                txtPartNumber.SetFocus
                
        Else
            ' No record found and user does not want to enter as new
            ' Blank out entered information
            cboPrefix.Value = Null
            txtPartNumber = Null
            Me.txtDwgNo = Null
            cboPrefix.SetFocus
            
            Exit Sub
            
        End If
        
    Else
        ' Record exists, show drawing information
        txtTitle.Value = rstDocMaster!Title
        txtMA.Value = rstDocMaster!MA
        txtDwgSize.Value = rstDocMaster!DwgSize
        txtSheetsNo.Value = rstDocMaster!SheetsNo
        txtAssignedTo.Value = rstDocMaster!AssignedTo
        txtAssignedDate.Value = rstDocMaster!AssignedDate
        txtApprovedBy.Value = rstDocMaster!ApprovedBy
        txtAprvdDate = rstDocMaster!AprvdDate
        txtRev.Value = rstDocMaster!Rev
        cboProdCode = rstDocMaster!ProdCode
        'txtType.Requery
        Me.txtDwgNo = strDwgNo
        ' Refresh Eco history for current drawing
        sbfEcoHistory.Requery
        ' Show footer with clickable command button
        Me.FormFooter.Visible = True
        Me.cmdClearDwgInfo.SetFocus
                
    End If
        
Exit_txtPartNumber_AfterUpdate:
    Exit Sub
    
Err_txtPartNumber_AfterUpdate:
    MsgBox Err.Description
    Resume Exit_txtPartNumber_AfterUpdate
    
End Sub

Duane
Hook'D on Access
MS Access MVP

 

[cdck]

Thank you, Golom, for that valuable resource to help me with future projects.

And thank you, dhookum, for helping me work out in this code what to do - it works perfectly!

Cheryl dc Kern