basically, I want to have the value of my combobox1 as a field name of my query below. can somebody help me here?
Dim db As Database
Dim rs As DAO.Recordset
Set db = OpenDatabase("\\location\file.mdb")
Set rs = db.OpenRecordset("select * from customerinfo " _
& "where '"& (combobox1.text) &"' likE '*" & (txtsearch) & "*';")
If rs.RecordCount = 0 Then
MsgBox "No Item Found"
Else
Do While Not rs.EOF = True
listbox.AddItem
On Error Resume Next
listbox.List(listbox.ListCount - 1, 0) = rs("Fieldname").Value
rs.MoveNext
Loop
end if
There is an error in your query:
where '"& (combobox1.text) &"' likE
This creates an incorrect where clause, where 'fieldname' likE, which should be where fieldname likeE. Change the query to:
where "& (combobox1.text) &" likE
Note: It is best to create the query string in a variable. That makes it easier to spot any errors.
Related
I'm trying to import all data from 3 columns in an access database (.mdb) into my Excel file, which is working, however the numbers that I'm importing aren't coming in correct. You can see in the images supplied what exactly is happening. I am wanting it to import exactly as it is in the database (to 1 decimal place). Now I've tried with changing the numberformat for the Excel columns but of course that only hides the true value with a shortened version so I'd like to avoid doing that.
Dealing with SQL in VBA is something new to me and I don't know Access very well either so I'm wondering if there is something I can add to the query that could affect why the numbers are changing when they get copied into my Excel sheet.
I'm going to be adding a lot more to the code later but just testing connection for now to get it working properly first.
Here is my code (Got the basis for it from a youtube video I found):
Sub GetDataFromAccess()
Application.screenupdating = False
On Error GoTo SubError
Dim db As DAO.Database, rs As DAO.Recordset, xlSheet As Worksheet, recCount As Long, SQL As String, _
TableName As String, FldrLoc As String, FileName As String, ImpSh As Worksheet
Set ImpSh = Sheets("Import")
FldrLoc = ImpSh.Range("D10").Value
FileName = ImpSh.Range("Q15").Value
If Right(FldrLoc, 1) = "\" Then
DbLoc = FldrLoc & FileName
Else
DbLoc = FldrLoc & "\" & FileName
End If
Set xlSheet = Sheets("CAL-53 INC")
If InStr(ImpSh.Range("Q15").Value, ".mdb") > 0 Then
TableName = ImpSh.Range("R5").Value & Left(ImpSh.Range("Q15").Value, Len(ImpSh.Range("Q15")) - 4)
Else
TableName = ImpSh.Range("R5").Value & ImpSh.Range("Q15").Value
End If
xlSheet.Range("G3:I5000").ClearContents
Application.StatusBar = "Connecting to the database..."
Application.Cursor = xlWait
Set db = OpenDatabase(DbLoc)
SQL = "SELECT LRP_CHAINAGE, LEFT_DEPTH, RIGHT_DEPTH" & _
" FROM " & TableName & " ORDER BY LRP_CHAINAGE "
Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
Application.StatusBar = "Writing to spreadsheet..."
If rs.RecordCount = 0 Then
MsgBox "No data from that table"
GoTo SubExit
Else
rs.MoveLast
recCount = rs.RecordCount
rs.MoveFirst
End If
xlSheet.Range("G3").CopyFromRecordset rs
'xlSheet.Range("G:I").NumberFormat = "0.0"
Application.StatusBar = "Update complete."
SubExit:
On Error Resume Next
Application.Cursor = xlDefault
rs.Close
Set rs = Nothing
Set xlSheet = Nothing
Application.screenupdating = True
Exit Sub
SubError:
Application.StatusBar = ""
MsgBox "Error: " & vbCrLf & Err.Number & " = " & Err.Description
Resume SubExit
End Sub
Here are the pictures of what is in the database and what it's coming in as:
As a quick work around you may set the SQL statement as follows:
SQL = "SELECT Fix(10*[" & TableName & "]![LRP_CHAINAGE])/10 AS LRP_CHAINAGE, Fix(10*[" & TableName & "]![LEFT_DEPTH])/10 AS LEFT_DEPTH, Fix(10*[" & TableName & "]![RIGHT_DEPTH])/10 AS RIGHT_DEPTH" & _
" FROM " & TableName & " ORDER BY LRP_CHAINAGE "
This will give you only one digit after decimal. If you need two digits just change multiplier and divider to 100 :)
SQL = "SELECT LRP_CHAINAGE*10, LEFT_DEPTH*10, RIGHT_DEPTH*10" & _
" FROM " & TableName & " ORDER BY LRP_CHAINAGE "
I'm not running access or windows, but I remember I've done something like this with sql server and excel since vba truncate decimal values
After this query, you can use an update query on the worksheet
UPDATE [IMPORT$]
SET LRP_CHAINAGE=LRP_CHAINAGE/10, LEFT_DEPTH/10, RIGHT_DEPTH/10
I would like to search the access database with the user initials in the UserInitials column but I get the error no value given for one or more required parameters
However, if I search the database with the ID in the ID column it works perfectly fine.
Is it possible to do this? I have checked the spelling which is fine and there are no empty fields in the database itself. I have also changed and set the Primary key from ID to UserInitials but this doesn't seem to make any difference.
Many thanks.
Public Function searchDatabase()
If UserForm1.TextBox4.Value = "" Then
MsgBox "field empty"
Else
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
con.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data
Source=C:\Users\MyPC\Desktop\DatabaseOne.accdb;"
'Open Db connection
con.Open
Set rs.ActiveConnection = con
rs.Open "Select * from TableUser where UserInitials= " & UserForm1.TextBox4.Text & ""
StartRow = 3
Do Until rs.EOF
'User Initials
UserForm1.TextBox1.Text = rs.Fields(1).Value
'User Full Name
UserForm1.TextBox2.Text = rs.Fields(2).Value
'User Email
UserForm1.TextBox3.Text = rs.Fields(3).Value
rs.MoveNext
StartRow = StartRow + 1
Loop
Set rs = Nothing
con.Close
Set con = Nothing
End If
End Function
You need to embed UserForm1.TextBox4.Text in quotation marks otherwise the SQL statement will not be interpreted correctly
Try
rs.open "Select * from TableUser where UserInitials= '" & UserForm1.TextBox4.Text & "'"
Further reading Quotation marks in string expressions
I'm new to VBA and am writing a macro that downloads data from Access based on a month-end date entered by the user.
Currently, I am having issues getting information to download from Access.
To be more specific: when I run the macro and enter in the month-end date, no data is downloaded but I also receive no error messages.
I have been trying different code iterations to try to get it to work. Before I was getting various error messages; now I get no error messages but no data downloads.
I was reading online that I need to use a function to get my variable from the input box (box) to work in the Access query. I am wondering if it has to do with how I have my function set up. Or is there an issue with my Access query.
Sub Expense_Download()
'
' Expense_Download Macro
'
Dim cnn As ADODB.Connection, rs As ADODB.Recordset, sQRY As String, strFilePath As String, box As Variant, myvar As Variant
strFilePath = "C:\Users\NVanWyk\Documents\Fidato\Lunch And Learn\Lunch and Learn Access DB\Nate's Expenses DB.accdb" 'Replace the ‘DatabaseFolder’ and ‘myDB.accdb’ with your DB path and DB name
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
box = InputBox("What month do you want expense data for? Please use the MM/DD/YYYY format.", "Expense Month?")
If Not IsDate(box) Then MsgBox "Value entered is not a valid date, please try again.", , "Input Value is Not Correct"
End
myvar = box
cnn.Open "provider = microsoft.ace.oledb.12.0;" & _
"Data Source=" & strFilePath & ";"
'have to indent the data source or the code does not run
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month=myvar()" 'Replace ‘tblData’ with your Access DB Table name or Query name from which you want to download the data"
rs.CursorLocation = adUseClient
rs.Open myvar(), sQRY, cnn, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet1.Range("A2").CopyFromRecordset rs
'sheet 1 for whatever reason still pastes to the "expense" sheet
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
First of all, the line that contains the word 'End' only, will stop execution.
If you want to stop execution in case of wrong user input, do this:
If Not IsDate(box) Then
MsgBox "Value entered is not a valid date, please try again.", , "Input Value is Not Correct"
End 'or Exit Sub
End If
You store the user's month input in myvar variable but then you don't actually put into the select query.
Instead of this:
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month=myvar()"
Try this:
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month= " & myvar
However, the value you are expecting in InputBox is not obvious. I'm assuming that it's a number between 1 and 12 and Expense_Month field is a number too in your database.
In case it contains the year too in YYYY-MM format and is a varchar, you will need to change your code like this:
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month= '" & myvar & "'"
Either of the above is true, IsDate is not the right function to check whether the input is correct. For example if the user types 20 into the box, it will return True as it is a date but January 20 of 1900.
Also, remove the first parameter myvar() from this line.
rs.Open myvar(), sQRY, cnn, adOpenStatic, adLockReadOnly
rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
Based on your additional input I recommend using YYYY-MM-DD as user input. So your query would be defined as:
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month= '" & myvar & "'"
To test your query, open Locals windows in VB editor, see what the value of sQRY is once execution reaches this point and run that in Access's SQL editor to see if it is going to work.
Thanks for the help everyone!
I made the edits above and did some other research and was able to get the code to work. I think the snag was because I was using a date (MM/DD/YYYY) as the variable, I needed to add the # signs in the query so that Access recognized the variable as a date.
Sub Expense_Download()
'
' Expense_Download Macro
'
Dim cnn As ADODB.Connection, rs As ADODB.Recordset, sQRY As String, strFilePath As String, box As Variant, myvar As Variant
strFilePath = "C:\Users\NVanWyk\Documents\Fidato\Lunch And Learn\Lunch and Learn Access DB\Nate's Expenses DB.accdb" 'Replace the ‘DatabaseFolder’ and ‘myDB.accdb’ with your DB path and DB name
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
box = InputBox("What month do you want expense data for? Please use the MM/DD/YYYY format.", "Expense Month?")
If Not IsDate(box) Then
MsgBox "Value entered is not a valid date, please try again.", , "Input Value is Not Correct"
End
End If
myvar = box
cnn.Open "provider = microsoft.ace.oledb.12.0;" & _
"Data Source=" & strFilePath & ";"
'have to indent the data source or the code does not run
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month= #" & myvar & "#" 'Replace ‘tblData’ with your Access DB Table name or Query name from which you want to download the data"
' access query
' # before and after the "myvar" variable are necessary for access to recognize the variable as a date and to run the query successfully.
rs.CursorLocation = adUseClient
rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet1.Range("A2").CopyFromRecordset rs
'sheet 1 for whatever reason still pastes to the "expense" sheet
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
I have created a userform that insert data into an Access table. while inserting data, I want to make sure that the ID inserted must exist in the Access table. I have used the DCOUNT function to do this but this is rendering a 'Type Mismatch' error. I have tried every solution found on the internet but nothing is working here. Please help!
I have modified the DCOUNT expression to put the form variable name into '', [], creating an external variable that refers to the DCOUNT function but nothing is working
Set conn = createobject("ADODB.connection")
set rs = createobject("ADODB.recordset")
strconn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data source = C:\MyPathMyDB.accdb"
qry = "select * from employee"
with rs
.adnew
if isnumeric(ManagerID) = false then
msgbox "Invalid Manager ID"
exit sub
elseif application.worksheetfunction.dcount("Employee_ID","Employee","activ='Yes' and Employee_ID='" & [EmployeeForm.ManagerID] & "'") = 0 then
msgbox "Manager does not exist"
exit sub
else
. fields("Manager_ID").value = ManagerID
end if
end with
I expect the function to determine if the Employeeform.ManagerID exist in Employee_ID. If yes, then proceed, else display error message
Since you check for the ManagerID to be numeric, I guess its value isn't text, and active is probably a boolean, and as you can access ManagerID on its own, use it as is, and the criteria could read:
"activ=True and Employee_ID=" & ManagerID & ""
Dcount (the one you're trying to use) is an Access function: the Excel one is for querying a worksheet range. you will need to query your access database to see if there's a record:
For example:
sql = "select * from employee where activ='Yes' and Employee_ID='" & _
[EmployeeForm.ManagerID] & "'"
rs.open sql, conn
If not rs.eof then
'got a match: add the new record and update to database
else
msgbox "Manager not found!"
end if
I would like to connect to my Access tables using VBA. I want to be able to type in a purchase order number, and reference that value in a query to the Access table. I want to print the results of that query to my Excel worksheet. This is what I have so far.. any ideas?
Sub CommandButton1_Click()
Dim myValue As Variant
myValue = InputBox("Enter Purchase Order Number:")
Range("A1").Value = myValue
Call ADO_Conn(myValue)
End Sub
Sub ADO_Conn(myValue)
Dim conn As New Connection
Dim rstAnswer As New ADODB.Recordset
Dim connected As Boolean
Dim RootPath, DBPath As String
Dim tempString As String
connected = False
RootPath = "Z:\BSD Internship Program\FY14 Intern Files\John Jameson\Vouchers"
DBPath = RootPath & "Acquisition Support Datamart Build 9.11-03.accdb"
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source= Z:\BSD Internship Program\FY14 Intern Files\John Jameson\Vouchers\Acquisition Support Datamart 9.1103.accdb;"
connected = True
rstAnswer.Open "SELECT VW_PUB_PURCHASE_ORDER.PO_NO FROM VW_PUB_PURCHASE_ORDER " & _
"WHERE VW_PUB_PURCHASE_ORDER.PO_NO = ' " & myValue & " ';", conn, adOpenKeyset, adLockOptimistic
Do Until rstAnswer.EOF
tempString = CStr(rstAnswer!VW_PUB_PURCHASE_ORDER)
Application.ActiveWorkbook.Worksheets("Sheet1").Range("A5").Value = tempString
rstAnswer.MoveNext
Loop
rstAnswer.Close
conn.Close
connected = False
End Sub
A couple of things about your initial query:
rstAnswer.Open "SELECT VW_PUB_PURCHASE_ORDER.PO_NO FROM VW_PUB_PURCHASE_ORDER " & _
"WHERE VW_PUB_PURCHASE_ORDER.PO_NO = ' " & myValue & " ';", conn, adOpenKeyset, adLockOptimistic
You are searching only for PO_NO in this query, so that is the only value that will return. If you want more than just that data (as I assume you might), then you want this:
rstAnswer.Open "SELECT * FROM VW_PUB_PURCHASE_ORDER " & _
"WHERE VW_PUB_PURCHASE_ORDER.PO_NO = ' " & myValue & " ';", conn, adOpenKeyset, adLockOptimistic
... where the asterisk means "all".
In addition, this bit concerns me:
' " & myValue & " '
You are adding leading and trailing blanks to your search term. This may or may not be what you want, but I assume that you do not want this. You probably want:
'" & myValue & "'
And if your PO_NO is a numeric value, you need to omit the apostrophes:
" & myValue & "
Lastly, I don't think you want to loop at all. The SELECT query will return all the results without requiring you to iterate rows. Maybe you should try getting rid of your "do" loop and using this instead:
Worksheets("Sheet1").Range("A5").CopyFromRecordset rstAnswer
Your query values will then be dropped into a dynamic range starting at the designated sheet & cell.
I didn't test the code so I might not have caught everything, but those jumped out at me.
Hope that helps!
Nate