I'm using the below code to load a table from an MDB database to an excel worksheet. I'm trying to define the table name as variable and pass it to query but I'm getting an error with the code below. How can I do this in VBA?
Public Sub ReadMdb()
Dim cn As Object, rs As Object
Dim intColIndex As Integer
Dim DBFullName As String
Dim TargetRange As Range
DBFullName = Application.GetOpenFilename()
On Error GoTo Oops
Application.ScreenUpdating = False
Set TargetRange = Sheets("Sheet1").Range("A1")
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName
Set rs = CreateObject("ADODB.Recordset")
Dim tableName As String
tableName = "Students"
rs.Open "SELECT * FROM tableName", cn, , , adCmdText
' Write the field names
For intColIndex = 0 To rs.Fields.Count - 1
TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
Next
' Write recordset
TargetRange.Offset(1, 0).CopyFromRecordset rs
LetsContinue:
Application.ScreenUpdating = True
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
On Error GoTo 0
Exit Sub
Oops:
MsgBox "Error Description :" & Err.Description & vbCrLf & _
"Error at line :" & Erl & vbCrLf & _
"Error Number :" & Err.Number
Resume LetsContinue
End Sub
you can insert table name into SQL:
rs.Open "SELECT * FROM [" & tableName & "]", cn, , , adCmdText
Considering your returning all the rows and all the columns, you could use the command type adCmdTable then you don't need any SQL you simply name the table that you want.
Related
I have an Access 365 database that has Invoice Numbers, Due Dates, and Amounts Due. I'm trying to create an Excel UDF, whereby I input the Due Date and Invoice Number, and the function queries the database and returns the Amount Due.
The formula result is #Value and there's no compiler error, though there appears to be an error when it attempts to open the record set (I set up a error message box for this action). Perhaps there's an issue with my SQL? I'd appreciate any assistance with this matter.
I've found several discussions of similar topic, but I've been unable to get this code to work. I'd appreciate any assistance with this matter.
https://www.mrexcel.com/board/threads/need-help-creating-user-defined-functions-in-excel-to-query-from-a-database.943894/
Here's the code:
Function CLLData(inpDate As Long, inpInvoiceNum As String)
Dim conn As Object
Dim rs As Object
Dim AccessFilePath As String
Dim SqlQuery As String
Dim sConnect As String
'Disable screen flickering.
Application.ScreenUpdating = False
'Specify the file path of the accdb file.
AccessFilePath = ThisWorkbook.Path & "\" & "CRDD.accdb"
'Create the connection string.
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFilePath
On Error Resume Next
'Create the Connection object.
Set conn = CreateObject("ADODB.Connection")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not created!", vbCritical, "Connection Error"
'Exit Sub
End If
On Error GoTo 0
On Error Resume Next
'Open the connection.
conn.Open sConnect
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not opened!", vbCritical, "Connection Open Error"
'Exit Sub
End If
On Error GoTo 0
'SQL statement to retrieve the data from the table.
SqlQuery = "SELECT [Value] FROM tblRawCallData WHERE (([DueDate] = '" & inpDate & "') AND ([Invoice] = '" & inpInvoiceNum & "'));"
On Error Resume Next
'Create the ADODB recordset object
Set rs = CreateObject("ADODB.Recordset")
'Check if the object was created.
If Err.Number <> 0 Then
Set rs = Nothing
Set conn = Nothing
MsgBox "Recordset was not created!", vbCritical, "Recordset Error"
'Exit Sub
End If
On Error GoTo 0
On Error Resume Next
'Open the recordset.
rs.Open SqlQuery, conn
'Check if the recordset was opened.
If Err.Number <> 0 Then
Set rs = Nothing
Set conn = Nothing
MsgBox "Recordset was not opened!", vbCritical, "Recordset open error"
'Exit Sub
End If
On Error GoTo 0
' Check there is data.
If Not rs.EOF Then
' Transfer result.
CLLData = rs!Value
MsgBox "Records: ", vbCritical, "Records"
' Close the recordset
Else
'Not found; return #N/A! error
CLLData = CVErr(xlErrNA)
MsgBox "No records in recordset!", vbCritical, "No Records"
End If
rs.Close
' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
'Enable the screen.
Application.ScreenUpdating = True
End Function
You need two or three corrections, as date values always should be handled as DateTime, and your invoice number most likely is numeric:
Function CLLData(inpDate As Date, inpInvoiceNum As String)
' <snip>
'SQL statement to retrieve the data from the table.
SqlQuery = "SELECT [Value] FROM tblRawCallData WHERE (([DueDate] = #" & Format(inpDate, "yyyy\/mm\/dd") & "#) AND ([Invoice] = " & inpInvoiceNum & "));"
Edit for numeric "date" and alpha-numeric invoice:
SqlQuery = "SELECT [Value] FROM tblRawCallData WHERE (([DueDate] = #" & Format(inpDate, "####\/##\/##") & "#) AND ([Invoice] = '" & inpInvoiceNum & "'));"
Seems like your function could be significantly less complex.
Comment out the error handler until you get it working when called from a Sub.
Function CLLData(inpDate As Long, inpInvoiceNum As String)
Dim conn As Object
Dim rs As Object
Dim AccessFilePath As String
Dim SqlQuery As String
Dim sConnect As String
AccessFilePath = ThisWorkbook.path & "\" & "CRDD.accdb"
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFilePath
On Error GoTo haveError
Set conn = CreateObject("ADODB.Connection")
conn.Open sConnect
SqlQuery = "SELECT [Value] FROM tblRawCallData WHERE [DueDate] = " & inpDate & _
" AND [Invoice] = '" & inpInvoiceNum & "'"
Set rs = CreateObject("ADODB.Recordset")
rs.Open SqlQuery, conn
If Not rs.EOF Then
CLLData = rs.Fields("Value").Value
Else
CLLData = CVErr(xlErrNA)
End If
rs.Close
Exit Function
haveError:
CLLData = "Error:" & Err.Description
End Function
I have written a query inside the combobox1_change event
Private Sub ComboBox1_Change()
On Error GoTo UserForm_Initialize_Err
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim result As Integer
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Users\inkapb\Desktop\EPC Database\EPC TOOL.mdb"
rst.Open "SELECT [Project_Id] FROM [Project Details] WHERE [Project Name] = '" & Me.ComboBox2.Value & "' ;", _
cnn, adOpenStatic
UserForm_Initialize_Exit:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
UserForm_Initialize_Err:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
Resume UserForm_Initialize_Exit
End Sub
The result of the above query is integer, could any one please tell me how to store the query result into result(int) variable.
You can read like so:
rst.Open ....
dim value as long
if not rst.eof then
value = rst.collect(0)
else
''no rows
end if
Please help to fix the following syntax error with Like statement. The query works with = but I need to use Like to search in the AAchange field. I think the problem is here "WHERE [AAchange] LIKE '" & "%" & _
but I'm not sure how to correct this syntax. Please see the code below:
Sub ColorNewVariant()
Dim PolicyNum As Variant
Dim bFound As Boolean
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rs As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim strSQL As String
Dim r As Range, cell As Range
Dim LastRow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Application.EnableEvents = False
Set r = ThisWorkbook.ActiveSheet.Range("G3:G" & LastRow)
For Each cell In r
If cell.Value <> "" Then
PolicyNum = cell.Value
dbPath = PATH_MAIN & "\Report\MDL_IonTorrent.accdb"
Set cnn = New ADODB.Connection ' Initialise the collection class variable
'Connection class is equipped with a -method- Named Open
'--4 aguments-- ConnectionString, UserID, Password, Options
'ConnectionString formula--Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
strSQL = "SELECT [AAchange] " & _
"FROM [MDL_Table1] " & _
"WHERE [AAchange] LIKE '" & "%" & _
Replace(PolicyNum, """", """""", , , vbTextCompare) & _
""""
'Create the ADODB recordset object.
Set rs = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '--5 aguments--
'Source, ActiveConnection, CursorType, LockType, Options
rs.Open strSQL, cnn
bFound = Not rs.EOF
'Check if the recordset is empty.
'Close the recordet and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'Enable the screen.
If bFound Then
'MsgBox "Record exists."
Else
'MsgBox "Record not found."
'cell.Interior.ColorIndex = 8
cell.Interior.Color = RGB(255, 217, 218)
'cell.ClearComments
'cell.AddComment "New Variant"
'Fits shape around text
'cell.Comment.Shape.TextFrame.AutoSize = True
End If
End If
Next cell
Application.EnableEvents = True
End Sub
Change the quoting in your query's WHERE clause.
If you use single quotes to start and end the string value you build, you needn't bother with Replace() of double quotes within the PolicyNum value. That should make this task simpler and less confusing ...
strSQL = "SELECT [AAchange] " & _
"FROM [MDL_Table1] " & _
"WHERE [AAchange] LIKE '%" & PolicyNum & "'"
Debug.Print strSQL
I am new to Excel VBA. I have a user form in which I am trying to populate names of those employees who are AMO. I have a database called Ofc. Under which I have a table EmployeeDetails. Primary key is PeoplesoftId.
Here is the structure and the contents of the Employee table:
PeoplesoftId Nameofemployee RacifId Employeeid Designation
43243309 Maddala V43309 99651823 AMO
43243310 Abhishek A43301 99651824 AMO
43243311 Atanu A43311 99651825 MO
43243312 Rajiv R43312 99651826 CSE
This is the code I've written so far:
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rs As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim SQL As String
Dim i As Integer
Dim var
'add error handling
On Error GoTo errHandler:
'Disable screen flickering.
Application.ScreenUpdating = False
dbPath = "E:\office_hsbc\ofc.accdb"
var = "AMO"
Set cnn = New ADODB.Connection ' Initialise the collection class variable
cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
cnn.Open
SQL = "SELECT Nameofemployee FROM EmployeeDetails where Designation= '" & var & "'"
Set rs = New ADODB.Recordset 'assign memory to the recordset
rs.Open SQL, cnn
If rs.EOF And rs.BOF Then
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'Enable the screen.
Application.ScreenUpdating = True
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If
For i = 0 To rs.Fields.Count - 1
comboamo.AddItem rs.Fields(i).Value, i
Next
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox "Congratulation the data has been successfully Imported", vbInformation, "Import successful"
'error handler
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rs = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Import_Data"
You need to move through each record in the recordset. Currently you are trying to read all of the fields from a single record but your query only returns one field. Try this instead:
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If
i = 0
Do Until rs.EOF
comboamo.AddItem rs.Fields("Nameofemployee").Value, i
rs.MoveNext
i = i + 1
Loop
rs.Close
Sub GetTextFileData(strSQL As String, strFolder As String, rngTargetCell As Range)
' example: GetTextFileData "SELECT * FROM filename.txt", _
"C:\FolderName", Range("A3")
' example: GetTextFileData "SELECT * FROM filename.txt WHERE fieldname = 'criteria'", _
"C:\FolderName", Range("A3")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, f As Integer
If rngTargetCell Is Nothing Then Exit Sub
Set cn = New ADODB.Connection
On Error Resume Next
cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"Dbq=" & strFolder & ";" & _
"Extensions=asc,csv,tab,txt;"
On Error GoTo 0
If cn.State <> adStateOpen Then Exit Sub
Set rs = New ADODB.Recordset
On Error Resume Next
rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
On Error GoTo 0
If rs.State <> adStateOpen Then
cn.Close
Set cn = Nothing
Exit Sub
End If
' the field headings
For f = 0 To rs.Fields.count - 1
rngTargetCell.Offset(0, f).Formula = rs.Fields(f).name
Next f
rngTargetCell.Offset(1, 0).CopyFromRecordset rs ' works in Excel 2000 or later
'RS2WS rs, rngTargetCell ' works in Excel 97 or earlier
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
I can't remember where I got the above code but it's really good. It allows me to use SQL on a CSV and extract the data I need.
Now I have a csv file where the column names can have a space in it and have other symbols such as % in the name. Now the code doesn't work. How do I tell VBA to select a column with a name such as "Swing %" the code below didn't work
GetTextFileData "select Swing % as swing_pct from data.csv", "c:\somewhere", Range("A1")
Try [] escaping;
select [Swing %] as ...
Note: Alex K mentioned this in the comment.