I am trying to create a function to retrieve all the data present in a table to use as an array. However, when I am using the method .GetRows (to get the number of the rows, so I can interact with them) it is returning 0.
Here is the coding I am using:
Option Compare Database
Function ListAllDatainTable(TableName As String) As String
Dim dbsNorthwind As DAO.Database
Dim rs As DAO.Recordset
Dim varRecords As Variant
Dim intNumRows As Integer
Dim intNumColumns As Integer
Dim intColumn As Integer
Dim intRow As Integer
Dim strSQL As String
Dim temp As String
Dim value As String
temp = ""
value = ""
Set dbsNorthwind = CurrentDb
strSQL = "SELECT * FROM " & TableName
Set rs = dbsNorthwind.OpenRecordset(strSQL)
varRecords = rs.GetRows()
intNumColumns = UBound(varRecords, 1)
intNumRows = UBound(varRecords, 2)
For intRow = 0 To intNumRows
temp = varRecords(intRow, 0)
value = value & "," & temp
Next intRow
ListAllDatainTable = value
rs.Close
dbsNorthwind.Close
Set rs = Nothing
Set dbsNorthwind = Nothing
End Function
The variable intNumRows, which should show the number of rows, shows 0.
The table I am using has a Single Column, but can have any number of rows.
Thanks for your help!
Regards!
Try this:
Set rs = dbsNorthwind.OpenRecordset(strSQL)
rs.MoveLast
rs.MoveFirst
varRecords = rs.GetRows(rs.RecordCount)
Related
PO_D_Temp contains several fields 2 of which are [InvNo] and [Detail_Line].There will be many rows that belong with same [InvNo]. I would like each [Detail_Line] to begin with 1, 2 etc for each [InvNo]
Example: [InvNo]1 [Detail_Line] 1 [InvNo]1 [Detail_Line] 2 [InvNo]2 [Detail_Line] 1 [InvNo]3 [Detail_Line] 1 ETC!
All I have been able to figure out is a loop that adds an incrementing number to ALL records - not renumbering at each different InvNo.
Here is what I have (I am at kindergarten level, sorry):
Private Sub Command1_Click()
Dim db As Database
Set db = CurrentDb()
Dim rstPO_D_Temp As Recordset
Dim strSQL As String
Dim intI As Integer
Dim DetailNum As Integer
'Open a recordset on all records from the PO_D_Temp table
strSQL = "SELECT * FROM PO_D_Temp"
Set rstPO_D_Temp = db.OpenRecordset(strSQL, dbOpenDynaset)
DetailNum = 0
' If the recordset is empty, exit.
If rstPO_D_Temp.EOF Then Exit Sub
intI = 1
With rstPO_D_Temp
Do Until .EOF
.Edit
![Detail_Line] = DetailNum + intI
.Update
.MoveNext
intI = intI + 1
Loop
End With
rstPO_D_Temp.Close
Set rstPO_D_Temp = Nothing
End Sub
Reset the detail no. for each invoice no.:
Private Sub Command1_Click()
Dim db As DAO.Database
Set db = CurrentDb()
Dim rstPO_D_Temp As DAO.Recordset
Dim strSQL As String
Dim DetailNum As Integer
Dim LastInvoice As Long
'Open a recordset on all records from the PO_D_Temp table
strSQL = "SELECT * FROM PO_D_Temp"
Set rstPO_D_Temp = db.OpenRecordset(strSQL, dbOpenDynaset)
With rstPO_D_Temp
Do Until .EOF
If LastInvoice <> !InvNo.Value Then
DetailNum = 1
LastInvoice = !InvNo.Value
Else
DetailNum = DetailNum + 1
End If
.Edit
![Detail_Line].Value = DetailNum
.Update
.MoveNext
Loop
.Close
End With
Set rstPO_D_Temp = Nothing
End Sub
Just started with Access VBA today and imagine this is a simple fix. The program calculates total guests in each service category. I must be missing something simple.
Public Sub CalculateTotalGuestsForEachService()
'Declare variables
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim intTotalParty As Integer
'Set the current database
Set db = CurrentDb
'Set the recordset
Set rst = db.OpenRecordset("Select Orders.* From Orders Where ServiceID = 1")
'Cycle through the records
Do While Not rst.EOF
intTotalParty = intTotalParty + rst!NoInParty
rst.MoveNext
Loop
'Display total amount
MsgBox "The total is " & intTotalParty
'Close the recordset
rst.Close
Set rst = Nothing
Set db = Nothing
End Sub
If any record has a Null value, apply Nz:
intTotalParty = intTotalParty + Nz(rst!NoInParty.Value, 0)
or, you could let the query sum the values:
'Set the recordset
Set rst = db.OpenRecordset("Select Sum(NoInParty) As TotalParty From Orders Where ServiceID = 1")
If rst.RecordCount = 1 Then
intTotalParty = Nz(rst!TotalParty.Value)
End If
First of all I'm new to VB so all help is very much appreciated.
I'm trying to populate a ComboBox in Excel with data from an SQL server.
The error is 'Dim cnt As ADODB.Connection' - Complie Error: User-defined type not defined
Sub Populate_ComboBox_From_SQL()
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stDB As String, stConn As String, stSQL As String
Dim xlCalc As XlCalculation
Dim vaData As Variant
Dim k As Long
Set cnt = New ADODB.Connection
stConn = "DSN=Backup;Trusted_Connection=Yes;APP=Microsoft Office;DATABASE=<database>"
cnt.ConnectionString = stConn
stSQL = "SELECT 'project no' FROM 'project register"
With cnt
.CursorLocation = adUseClient
.Open stConn 'Open connection.
Set rst = .Execute(stSQL)
End With
With rst
Set .ActiveConnection = Nothing 'Disconnect the recordset.
k = .Fields.Count
vaData = .GetRows
End With
cnt.Close
With TEMPLATE
With .ComboBox1
.Clear
.BoundColumn = k
.List = Application.Transpose(vaData)
.ListIndex = -1
End With
End With
Set rst = Nothing
Set cnt = Nothing
End Sub
The sheet is called TEMPLATE and the ComboBox is called ComboBox1.
I have omitted the name of the SQL server in the connection string.
Thanks in advance.
Thanks for looking at this.
I have a recordset with 60 fields and I want to export the last record for each field into a Microsoft Word file with 60 bookmarks called g1 to g60.
Of course I would like to loop through these but can't make it work.
Essentially what I want is this:
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim wDoct As Word.Document
Dim rs As DAO.Recordset
Dim rng As Word.Range
Dim intI As Integer
Dim fld As DAO.field
Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open("C:\Users\Peter\Documents\testdoc.docm", ReadOnly:=False)
Set wDoct = wApp.Documents.Open("C:\Users\Peter\Documents\Trends.docx")
Set rs = CurrentDb.OpenRecordset("Overall")
Set rs = CurrentDb.OpenRecordset("Grades")
If Not rs.EOF Then rs.MoveLast
wDoc.Bookmarks("g1").Range.Text = Nz(rs!PlanQ, "")
wDoc.Bookmarks("g2").Range.Text = Nz(rs!PlanQMin, "")
wDoc.Bookmarks("g3").Range.Text = Nz(rs!PlanUnsat, "")
wDoc.Bookmarks("g4").Range.Text = Nz(rs!BriefQ, "")
wDoc.Bookmarks("g5").Range.Text = Nz(rs!BriefQmin, "")
wDoc.Bookmarks("g6").Range.Text = Nz(rs!BriefUnsat, "")
' and so on up to 60
wDoct.Save
wApp.Quit
This works but needs to be looped of course - I tried this, but it errors out:
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim wDoct As Word.Document
Dim rs As DAO.Recordset
Dim rng As Word.Range
Dim intI As Integer
Dim fld As DAO.field
Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open("C:\Users\Peter\Documents\testdoc.docm", ReadOnly:=False)
Set wDoct = wApp.Documents.Open("C:\Users\Peter\Documents\Trends.docx")
Set rs = CurrentDb.OpenRecordset("Overall")
Set rs = CurrentDb.OpenRecordset("Grades")
If Not rs.EOF Then rs.MoveLast
intI = 1
With rs
Do Until .EOF
For Each fld in rs.Fields
wDoc.Bookmarks("g" & "intI").Range.Text = Nz(rs!fld.Name, "")
Next fld
intI = intI + 1
loop
End With
wDoct.save
Wapp.quit
Any ideas will be very much welcome, otherwise I have a lot of typing ahead of me. :-)
Thank you for your time!
Peter
This is the current code that fail like mentioned below:
UPDATE This is the exact copy paste.
Public Sub Looptest()
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim rs As DAO.Recordset
Dim index As Integer
Dim item As Variant
Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open("C:\Users\Peter\Documents\testdoc.docm", ReadOnly:=False)
Set rs = CurrentDb.OpenRecordset("Grades")
If Not rs.EOF Then rs.MoveLast
For Each item In rs.Fields
index = index + 1
Dim bookmarkName As String
bookmarkName = "g" & index
Dim bookmarkValue As Variant
bookmarkValue = Nz(rs(item.Name).Value, "")
Debug.Print "Try set bookmark '" & bookmarkName & "' to '" & bookmarkValue & "' now."
Dim bookmarkRange As Word.Range
Set bookmarkRange = wDoc.Bookmarks(bookmarkName).Range
bookmarkRange.Text = bookmarkValue
Set bookmarkRange = Nothing
Next item
wApp.DisplayAlerts = False
wDoc.SaveAs2 "C:\Users\Peter\Documents\" & rs!ID & "_gradesheet.docm"
wDoc.Close
wApp.Quit
This seems to be what you want:
Dim index As Integer
Dim item As Variant
For Each item In rs.Fields
index = index + 1
wDoc.Bookmarks("g" & index).Range.Text = Nz(rs(item.Name).Value, "")
Next item
It iterates the fields of the recordset and fills the bookmarks like you seem to want it.
What exactly error did you receive?
You should also check your code again, there are some superfluous fragments in it.
Update:
You get this error as I understand:
5941: The requested member of the collection does not exist.
Try this instead. It separates the functionality to single steps, enabling you to determine what the cause is:
It builds the new bookmark name
It retrieves the value to set to the bookmark
It prints out which bookmark now will be set to which value
It gets a reference to the bookmark to be set
It sets the bookmarks value
You should be able now to find out the reason for the error, by seeing which line of code breaks and what the values of the variables are.
Dim index As Integer
Dim item As Variant
For Each item In rs.Fields
If item.Name <> "ID" Then
index = index + 1
If index = 127 Then Exit For
Dim bookmarkName As String
bookmarkName = "g" & index
Dim bookmarkValue As Variant
bookmarkValue = Nz(rs(item.Name).Value, "")
Debug.Print "Try set bookmark '" & bookmarkName & "' to '" & bookmarkValue & "' now."
Dim bookmarkRange As Word.Range
Set bookmarkRange = wDoc.Bookmarks(bookmarkName).Range
bookmarkRange.Text = bookmarkValue
Set bookmarkRange = Nothing
End If
Next item
Your code tries to match numbered bookmarks to table fields, based only on their order. Even if you get it to work now, this will be very hard to maintain, every change will cause new troubles.
It is much easier to name the bookmarks identical to their matching table field names, i.e. PlanQ etc.
Then your code becomes simpler and maintainable.
And if a table field (e.g. ID) doesn't exist as bookmark in the document, you can simply ignore it.
For Each fld In rs.Fields
Dim bookmarkName As String
bookmarkName = fld.Name
Dim bookmarkValue As String ' since you are using Nz(), you don't need Variant
bookmarkValue = Nz(fld.Value, "")
If wDoc.Bookmarks.Exists(bookmarkName) Then
wDoc.Bookmarks(bookmarkName).Range.Text = bookmarkValue
Else
Debug.Print "Ignored table field <" & bookmarkName & "> - no matching bookmark found in word document."
End If
Next item
I construct hundreds of SQL Queries in an excel sheet and each one is placed in a cell of 1 column. What I am looking to do is run each of these SQL statements from excel.
Just wondering if anyone knows a way to convert all my SQL into VBA Strings to that I can loop through all rows to run each query.
I found this which is what I want to do but is there a way I can alter the code so it can read off excel cells rather than a Form?
http://allenbrowne.com/ser-71.html
Thanks
EDIT: Here is a sample SQL that I am trying to convert
SELECT
TT.TEST_TABLE_ID,
TT.TEST_TABLE_NO,
TT.MEMBERSHIP_NUMBER,
TT.TEST_TABLE_TYPE,
from TEST_TABLE TT
I think because each Select is in its own line it causes problems when it converts.
EDIT #2: Here is my code that executes SQL
Sub GetData()
Dim Conn As New ADODB.Connection
Dim RS As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim sqlText As String
Dim Row As Long
Dim Findex As Long
Dim Data As Worksheet
Dim X As Long
Set Data = Sheets("Results")
Data.Select
Cells.ClearContents
Conn.Open "PROVIDER=ORAOLEDB.ORACLE;DATA SOURCE=ORCL;USER ID=user;PASSWORD=password"
cmd.ActiveConnection = Conn
cmd.CommandType = adCmdText
'sqlText = How to reference Valid SQL cells
cmd.CommandText = sqlText
Set RS = cmd.Execute
For X = 1 To RS.Fields.Count
Data.Cells(1, X) = RS.Fields(X - 1).Name
Next
If RS.RecordCount < Rows.Count Then
Data.Range("A2").CopyFromRecordset RS
Else
Do While Not RS.EOF
Row = Row + 1
For Findex = 0 To RS.Fields.Count - 1
If Row >= Rows.Count - 50 Then
Exit For
End If
Data.Cells(Row + 1, Findex + 1) = RS.Fields(Findex).Value
Next Findex
RS.MoveNext
Loop
End If
Cells.EntireColumn.AutoFit
End Sub
in the SQL text part I want to be able to reference my column of SQL statements that I have. I thought I needed to convert it but you guys are right that if referencing it I can Just use your code Brad.
I tried to incorporate your code brad where my 'sqlText = How to reference Valid SQL cells is but had no success
Here is a start to the code I think you need.
I have placed the SQL in a sheet named "SQL", in Col A.
The issues with this are:
(1) You are placing field names in a row, then the data that is returned into a row. That will require two rows per SQL statement.
(2) I copied the SQL statement from sheet "SQL' and placed in Col A of "Results" (you mentioned you wanted to place results to right of SQL String. (3) You clear the contents of "Results" sheet, so you need to be careful not to erase your SQL if you decide to combine sheets.
Option Explicit
Sub Process_SQL_Strings()
Dim cmd As New ADODB.Command
Dim sqlText As String
Dim Row As Long
Dim Findex As Long
Dim Data As Worksheet
Dim iFldCt As Long
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConn As String
Dim lLastRow As Long
Dim lRow As Long
Set Data = Sheets("Results")
Data.Select
Cells.ClearContents
conn.Open "PROVIDER=ORAOLEDB.ORACLE;DATA SOURCE=ORCL;USER ID=user;PASSWORD=password"
cmd.ActiveConnection = conn
cmd.CommandType = adCmdText
'' Set conn = New ADODB.Connection
'' sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
'' "Data Source=C:\data\access\tek_tips.accdb;" & _
'' "Jet OLEDB:Engine Type=5;" & _
'' "Persist Security Info=False;"
conn.Open sConn
'sqlText = How to reference Valid SQL cells
lRow = 1
Do
sqlText = Sheets("SQL").Range("A" & lRow)
If sqlText = "" Then
MsgBox "Finished processing " & lRow & " rows of SQL", vbOKOnly, "Finished"
GoTo Wrap_Up
End If
Set rs = New ADODB.Recordset
rs.Open sqlText, conn, adOpenStatic, adLockBatchOptimistic, adCmdText
Data.Cells(lRow, 1) = sqlText
If not rs.EOF then
For iFldCt = 1 To rs.Fields.Count
Data.Cells(lRow, 1 + iFldCt) = rs.Fields(iFldCt - 1).Name
Next
If rs.RecordCount < Rows.Count Then
Data.Range("B" & lRow).CopyFromRecordset rs
Else
Do While Not rs.EOF
Row = Row + 1
For Findex = 0 To rs.Fields.Count - 1
If Row >= Rows.Count - 50 Then
Exit For
End If
Data.Cells(Row + 1, Findex + 1) = rs.Fields(Findex).value
Next Findex
rs.MoveNext
Loop
End If
Cells.EntireColumn.AutoFit
End If
lRow = lRow + 1
Loop
Wrap_Up:
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
End Sub
I am using something this:
Function SQLQueryRun(ByVal query As String, ByVal returnData As Boolean) As Variant
Dim Conn As New ADODB.Connection
Dim ADODBCmd As New ADODB.Command
Dim ret As New ADODB.Recordset
Conn.ConnectionString = "connection_string_here"
Conn.Open
ADODBCmd.ActiveConnection = Conn
ADODBCmd.CommandText = query
Set ret = ADODBCmd.Execute()
If returnData Then
If Not ret.EOF Then SQLQueryRun = ret.GetRows()
Else
SQLQueryRun = True
End If
Conn.Close
Set Conn = Nothing
Set ret = Nothing
End Function
If the second argument is False nothing is returned by function. Are you expecting results from query run?
Also I use a macro to create Query/Pivot table from sql contained in windows clipboard, if you are interested let me know.
You'll need to create a connection to your database and loop through all the cells and execute your code in each cell.
You can use ADO to to make the connection (need to add a reference to Microsoft ActiveX Data Objects 6.1 Library)
You'll need to figure out your connection string, open a connection, then loop through all the cells and execute the SQL in those cells.
Dim cnn As New ADODB.Connection
Dim connectionString As String
Dim cmd As New ADODB.Command
Dim c As Range, ws As Worksheet
Dim rst as ADODB.Recordset
connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data source=C:\Database3.accdb;Persist Security Info=False;"
cnn.Open connectionString
cmd.ActiveConnection = cnn
For Each c In ws.Range()
cmd.CommandText = c.Value
set rst = cmd.Execute
'do what you need to with your new recordset before moving on to the next SELECT
Next c