PDA

View Full Version : Word 2013 & Access 2013 - Query DB



bigal.nz
10-02-2015, 11:25 PM
Hi All,

I want to start off getting data from a table in a database and display the result of a specific field from a query in a msgbox.

I am on Word 2013 and Access 2013.

So far I seem to be able to open the connection ok, but I think something is wrong with the query as I get a error:




Sub Database()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim txt As String
Dim strSQL As String

Set conn = New ADODB.Connection
conn.Mode = adModeRead
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.15.0;Data Source=C:\Users\Al\Documents\Database1.accdb"
conn.Open

strSQL = "SELECT Surname FROM staff WHERE ID=123"

Set rs = New ADODB.Recordset
rs.Open strSQL, conn
If rs.RecordCount > 0 Then
MsgBox "Hello"
MsgBox rs.Fields("Surname").Value
End If
End Sub




The error is

Runtime Error '-2147217904 (80040e10)'
No value given for one or more required parameters

Please help.

Cheers

-Al

gmayor
10-03-2015, 01:18 AM
The following is the code I use in my systems to attain the same end ... and this does work. The code uses late binding so no reference to the object library is required


Option Explicit

Sub GetData()
Dim dbEng As Object
Dim db As Object
Dim rs As Object
Const strDatabase As String = "C:\Users\Al\Documents\Database1.accdb"
Const strTableName As String = "staff"
Const strID As String = "123"

Set dbEng = CreateObject("DAO.DBEngine.120")
Set db = dbEng.Workspaces(0).OpenDatabase(strDatabase, 2)

Set rs = db.openrecordset("SELECT * FROM " & strTableName & " WHERE ID = " & strID & "")
If rs.RecordCount > 0 Then
MsgBox rs.Fields("Company").Value
Else
MsgBox "Record not found"
End If
lbl_Exit:
Set dbEng = Nothing
Set db = Nothing
Set rs = Nothing
Exit Sub
End Sub

bigal.nz
10-03-2015, 01:25 AM
The following is the code I use in my systems to attain the same end ... and this does work. The code uses late binding so no reference to the object library is required


Option Explicit

Sub GetData()
Dim dbEng As Object
Dim db As Object
Dim rs As Object
Const strDatabase As String = "C:\Users\Al\Documents\Database1.accdb"
Const strTableName As String = "staff"
Const strID As String = "123"

Set dbEng = CreateObject("DAO.DBEngine.120")
Set db = dbEng.Workspaces(0).OpenDatabase(strDatabase, 2)

Set rs = db.openrecordset("SELECT * FROM " & strTableName & " WHERE ID = " & strID & "")
If rs.RecordCount > 0 Then
MsgBox rs.Fields("Company").Value
Else
MsgBox "Record not found"
End If
lbl_Exit:
Set dbEng = Nothing
Set db = Nothing
Set rs = Nothing
Exit Sub
End Sub

Thanks Graham.

The message I am getting now is: "No Value Given For one or More required parameters" on the rs.open line.

I think its something do with the SQL string?

Does ID=123 need to be ID='"123";' ? So that its SQL access will recognise?

Cheers

-Al

bigal.nz
10-03-2015, 01:30 AM
PS: I tried your code and get runtime error: "Too Few parameters. Expected 1" on the set rs line.

gmayor
10-03-2015, 02:57 AM
Greg?

The error is in the line
MsgBox rs.Fields("Company").Value
which is a value from my test database:banghead:. It should have read
MsgBox rs.Fields("surname").Value
123 is correct as shown ... for ID number 123.
The following is converted to a function which you can call with the required values (those shown are the ones from your original message) and includes some error handling if the values you enter are invalid.
Option Explicit
Sub ExampleMacro()
Dim strResult As String
Const strDatabase As String = "C:\Users\Al\Documents\Database1.accdb"
Const strTableName As String = "staff"
Const strID As String = "123"
Const strField As String = "surname"

strResult = GetData(strDatabase, strTableName, strID, strField)
If strResult = "" Then
MsgBox "Record Not Found"
Else
MsgBox strResult
End If
lbl_Exit:
Exit Sub
End Sub


Function GetData(strDatabase As String, _
strTableName As String, _
strID As String, _
strField As String) As String
Dim dbEng As Object
Dim db As Object
Dim rs As Object
On Error GoTo err_Handler
Set dbEng = CreateObject("DAO.DBEngine.120")
Set db = dbEng.Workspaces(0).OpenDatabase(strDatabase, 2)

Set rs = db.openrecordset("SELECT * FROM " & strTableName & " WHERE ID = " & strID & "")
If rs.RecordCount > 0 Then
GetData = rs.Fields(strField).Value
Else
GetData = ""
End If
lbl_Exit:
Set dbEng = Nothing
Set db = Nothing
Set rs = Nothing
Exit Function
err_Handler:
MsgBox "Unhandled error " & Err.Number & vbCr & Err.Description, vbCritical
Err.Clear
GetData = ""
GoTo lbl_Exit
End Function

bigal.nz
10-03-2015, 03:16 AM
Ok I fixed it. Needed some extra '




Sub GetData()
Dim dbEng As Object
Dim db As Object
Dim rs As Object
Const strDatabase As String = "C:\Users\Al\Documents\Database1.accdb"
Const strTableName As String = "staff"
Const strID As String = "TSCL55"

Set dbEng = CreateObject("DAO.DBEngine.120")
Set db = dbEng.Workspaces(0).OpenDatabase(strDatabase, 2)

Set rs = db.openrecordset("SELECT * FROM " & strTableName & " WHERE QID = '" & strID & "';")
If rs.RecordCount > 0 Then
MsgBox rs.Fields("Surname").Value
Else
MsgBox "Record not found"
End If
lbl_Exit:
Set dbEng = Nothing
Set db = Nothing
Set rs = Nothing
Exit Sub
End Sub




This line



Set rs = db.openrecordset("SELECT * FROM " & strTableName & " WHERE QID = '" & strID & "';")