How can I foreach the returned rows from ADODB.Resultset? And is it possible to get values by column name (for example if I want to get value from column "name" at row 3 to cell A1)?
Here is my current code without any loops:
Dim oConn As ADODB.Connection
Set oConn = New ADODB.Connection
oConn.Open "Driver={MySQL ODBC 5.2 Unicode Driver};Server=****;Database=****;Uid=****;Pwd=****;"
Dim oRS As ADODB.Recordset
Set oRS = New ADODB.Recordset
oRS.Open "SELECT * FROM report_access", oConn, adOpenStatic
With oRS
Cells(1, 1).CopyFromRecordset oRS
End With
Thanks in advance.
Try this for iteration
while not (ors.EOF Or ors.BOF)
for each x in ors.Fields
'Assign cell content
next
ors.MoveNext
wend
you can move the queried data to an array using the 'GetRows' and get the values from the array as you wish
For example
arr = oRS.GetRows
i = 0
If Not (oRS.EOF And oRS.BOF) Then
oRS.MoveFirst
Do Until oRS.EOF = True
MsgBox arr(0, i)
i = i + 1
oRS.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
This will Alert the first column values
Note : Here arr(3,2) means 3rd column and 2nd row
Not directly. You can move to row 3 with 3 oRS.MoveNext
while not oRS.EOF And oRS.AbsolutePosition < 2
oRS.MoveNext
wend
[A1] = oRS.Fields("name")
or you can find the index of the "name" field and use oRS.GetRows
Dim nameIndex As Integer
For nameIndex = 0 To oRS.Fields.Count - 1
If oRS.Fields(nameIndex).Name = "name" Then Exit For
Next
arr = oRS.GetRows
[a1] = arr(2, nameIndex)
Update
You can probably use oRS.Move
oRS.Move 2
[A1] = oRS.Fields("name")
Related
I have a table on Excel, range A1:Sn (where n is the LastRow). Previously I used to to loop in each row and insert it one by one.
This works fine, and I can resort back to it, but I am looking to insert the entire recordset ("A1:S" & LastRow) into SQL Table, rather than looping row by row.
The reason for this is if I am inserting as a whole recordset will be treated as 1x operation, and therefore will make generating a receipt id for multiple users significantly easier.
Code
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
dim i as long
dim LastRow as long
LastRow = Sheets("Project_Name").Cells(Rows.count, "B").End(xlUp).row
con.Open "Provider=SQLOLEDB; Data Source=LO1WPFSASDB001 ; Initial Catalog=database; User ID=username; Password=password; Trusted_Connection=no"
rs.Open "SELECT * from table;", con, adOpenKeyset, adLockOptimistic
With rs
for i = 1 to LastRow
.addnew
!somevalue = range("A1:S" & LastRow)
.update
next
.Close
End With
con.Close
Set con = Nothing
Set rs = Nothing
I cannot seem to get it to work. I would appreciate your input.
It seems that you need to change the loop structure.
Dim con As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim strConn As String
Dim i As Long, j As Integer
Dim LastRow As Long
Dim vDB
Set con = New ADODB.Connection
Set Rs = New ADODB.Recordset
LastRow = Sheets("Project_Name").Cells(Rows.Count, "B").End(xlUp).Row
vDB = Sheets("Project_Name").Range("A1:S" & LastRow)
strConn = "Provider=SQLOLEDB; Data Source=LO1WPFSASDB001 ; Initial Catalog=database; User ID=username; Password=password; Trusted_Connection=no"
With Rs
.ActiveConnection = strConn
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open
For i = 1 To UBound(vDB, 1)
.AddNew
For j = 1 To UBound(vDB, 2)
.Fields(j) = vDB(i, j)
Next j
.Update
Next i
End With
With Rs
End With
Set Rs = Nothing
You still need to loop the data on excel and insert/add it.
Following your current code. The second loop is to insert the columns.
for i = 1 to LastRow
.addnew
For n = 0 To .Fields.Count - 1
.Fields(n).Value = Cells(i, n + 1)
Next n
.update
next
I would take a different approach to avoid the second loop. Instead of using .addnew I would loop the data in excel, create the INSERT Strings and do an .Execute "INSERT ..." instead. You can skip the rs.Open using this method, just opening the connection and executing on it is fine.
for i = 1 to LastRow
sqlString = "INSERT INTO TableName (Field1, Field2, Field3, Field4...) VALUES (Cells(i, 1), Cells(i, 2), Cells(i, 3), Cells(i, 4)...)"
con.Execute(sqlString)
next
Edit: Using the insert method, you must enclose text values with ' marks otherwise the INSERT statement will return an invalid value type.
I have a sql query that outputs certain currency value. I need to extract that table to my excel worksheet and then divide the currency by 1. In my case, only the first currencies gets retrieved currently, and then rest just copies the same value as the first currency. Should I follow a different approach ?
Dim rst As ADODB.Recordset
Set rst = conn.Execute("SELECT [midpoint] " _
& "FROM[FOREX] " _
& "Where currency in ('CAD','AUD','EURO','HKD','JPY','MYR','NZD','SGD','THB') and " _
& "xdate=(select max(xdate) FROM [FOREX] where currency in ('CAD','AUD','EURO','HKD','JPY','MYR','NZD','SGD','THB'))")
If rst.EOF Then
Exit Sub
End If
Dim rstCAD As Double
Sheets("Tables").Range("FX2USD_CAD").Value = 1 / rst(0)
Sheets("Tables").Range("FX2USD_AUD").Value = 1 / rst(1)
Sheets("Tables").Range("FX2USD_EURO").Value = 1 / rst(2)
Sheets("Tables").Range("FX2USD_HKD").Value = 1 / rst(3)
Sheets("Tables").Range("FX2USD_JPY").Value = 1 / rst(4)
Sheets("Tables").Range("FX2USD_MYR").Value = 1 / rst(5)
Sheets("Tables").Range("FX2USD_NZD").Value = 1 / rst(6)
Sheets("Tables").Range("FX2USD_SGD").Value = 1 / rst(7)
Sheets("Tables").Range("FX2USD_THB").Value = 1 / rst(8)
Sheets("Tables").Range("FXLastUpdated").Value = Now
End If
rst(1) attempts to read the 2nd column of the first row, but you only have one column.
You need to call .movenext to move to the next row, you could loop but you have a predefined order of values so instead you could:
dim sht as worksheet: set sht = Sheets("Tables")
with sht
.Range("FX2USD_CAD").Value = 1 / rst(0)
rst.movenext
.Range("FX2USD_AUD").Value = 1 / rst(0)
rst.movenext
... and so on
end with
You need to modify your SQL & add an ORDER BY clause to make sure the order of rows in the query results match the order of FX2USD_CAD_* in your code.
You must wrap your code into a while-loop:
i = 0
While Not rs.EOF ' keep cycling untill all rows have been retrived
' write the value of the i-th cell
Sheets("Tables").offset(index).Range("FX2USD_CAD").Value = 1 / rst(0)
' one line per column (FX2USD_AUD, FX2USD_EURO, ...)
rst.MoveNext ' retrive the next row
i = i + 1 ' mode the index by one
Wend
and, of course, close your statement when you're finished: rst.Close
My actual code is the following:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call extract
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End SubSub extract()
Dim cn As Object
Dim uid1, pass1, srvrnm --pass parm
Set cn = CreateObject("ADODB.Connection")
Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")
Dim cmdSQLData As Object
Set cmdSQLData = CreateObject("ADODB.Command")
uid1 = "SSSS" --user-id
pass1 = "JJJJ" --pass words
srvrnm = "JJJJSDS" --server name
On Error GoTo err1
cn.Open "Driver=Teradata; DBCName="& srvrnm& ";uid="& uid1& ";AUTHENTICATION=ldap;pwd="& pass1& "; Trusted_Connection=True"
Set cmdSQLData.ActiveConnection = cn
On Error Resume Next
query1 = "select tablename,databasename as xx from DBC.TABLES sample 2;"
cmdSQLData.CommandText = query1
cmdSQLData.CommandTimeout = 0
Set rs = cmdSQLData.Execute()
Sheet1.Cells(2, 1) = rs.Fields(0).Value
Set rs = Nothing
err1:
End Sub
My question is how to get database table result in excel rows and column with as many rows as in table and consequent number of columns
You need to loop through your recordset and display the data. So where you have this:
Set rs = cmdSQLData.Execute()
Sheet1.Cells(2, 1) = rs.Fields(0).Value
Set rs = Nothing
You need something like this:
Dim r as Integer 'Row
Dim c as Integer 'Column
For c = 0 To rs.Fields.Count - 1
'This will start on Row 1, Column A (due to + 1) and place all the field headers
Sheet1.Cells(1, c + 1).Value = rs.Fields(c).Name
Next c
r = 3 'We'll start on Row 3
Do While Not rs.EOF
For c = 0 to rs.Fields.Count - 1
'c + 1 means we're starting on Column 1 (A)
'If we wanted to start in Column d, we would use c + 4
Sheet1.Cells(r, c + 1).Value = rs.Fields(c)
Next
r = r +1
rs.MoveNext
Loop
Regarding the comments: To add the field headers, you create an initial loop and simply do not move to the next record. See the modified code above.
The fastest way to copy the entire recordset to an excel sheet should be:
Sheet1.Cells(2, 1).CopyFromRecordset rs
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Closed 9 years ago.
Improve this question
I have 9 sheets that connect to different tables in teradata, each time i have to enter my user name and password to refresh and get new set of data. could someone please advice how do i write a VBA code that could change the connection string for each connection and refresh the data table.I am a begginner in VBA and have no clue in codding in VBA
Thanks
Syam
Here is what I do: I put the following in cells A2:B5
Data Source:
Database:
I put the SQL in cell D2. I use Row 1 for telling me how long the query takes. Then, I add a button anywhere on the page. Then I call the code below. It looks complicated, but the core of the functionality is all in Get_Data_Teradata.
The Get_SQL Function simply reads down column D until it finds a blank row and then returns a big block of text for the SQL. You could replace this with a hardcoded SQL statement.
Pop_Col_Heads puts the column headings from the result in Row 1. Note, that I have discovered a Bug in Excel 2010 on Win 7 where I can only populate columns once or twice per Excel session. If I quit and load Excel again, it works another once or twice.
Copy_Data_From_RDBMS places the ADODB RecordSet into a range in the active sheet. I had to do some tweaks to handle inserts and updates because they don't return any rows.
Sub Get_Data_Teradata()
'Supports Multi Query
Dim cn As ADODB.Connection
Dim sConnect As String
Set cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim cmdSQLData As ADODB.Command
Set cmdSQLData = New ADODB.Command
Dim sQueries() As String
sConnect = "Persist Security Info=True; Session Mode=ANSI; " & _
"Data Source=" & ActiveSheet.Range("B2").Value & ";" & _
"Database=" & ActiveSheet.Range("B3").Value & ";" & _
"User ID=" & ActiveSheet.Range("B4").Value & ";" & _
"Password=" & ActiveSheet.Range("B5").Value & ";"
sQueries = Get_SQL(ActiveSheet.Range("D2:D9999"))
nRow = 1 'initialize to start at the top of the page
For i = 0 To UBound(sQueries) - 1
cn.Open sConnect
Set cmdSQLData.ActiveConnection = cn
cmdSQLData.CommandText = sQueries(i) 'TELL VBA TO LOAD THE QUERY INTO TERADATA
cmdSQLData.CommandType = adCmdText
cmdSQLData.CommandTimeout = 0
Set rs = cmdSQLData.Execute()
Call Pop_Col_Heads(rs, nRow)
nRow = Copy_Data_From_RDBMS(rs, nRow)
cn.Close
Next i
End Sub
Dim a As Long
Dim i As Long
Dim nIndex As Long
Dim sSQL() As String
Function Get_SQL(oRange As Object) As String()
'First figure out how many rows the SQL statement is
a = 0
For Each cCell In oRange
a = a + 1
If cCell.Value = "" Then
a = a - 1
Exit For
End If
Next cCell
'Num rows = a now
'Step through and parse into array
i = 0
nIndex = 0
ReDim Preserve sSQL(1)
For Each cCell In oRange
i = i + 1
If i > a Then
Exit For
ElseIf cCell.Value = "<Multi>" Then
nIndex = nIndex + 1
ReDim Preserve sSQL(nIndex + 1)
Else
sSQL(nIndex) = sSQL(nIndex) & To_Text(cCell.Value) & " "
End If
Next cCell
Get_SQL = sSQL
End Function
Sub Pop_Col_Heads(rs As Object, nRow As Long)
Dim rHeads As Range
Dim fFields As Field
Dim nCol As Integer
nCol = 0
If nRow = 1 Then
ActiveSheet.Range("E1:ZZ1").ClearContents
End If
Set rHeads = ActiveSheet.Range("E1").Offset(nRow - 1, 0)
Do While nCol < rs.Fields.Count
sTemp = rs.Fields(nCol).Name
rHeads.Cells(nRow, nCol + 1).Value = rs.Fields(nCol).Name
ActiveSheet.Calculate
rHeads.Cells(nRow, nCol + 1).Value = sTemp
nCol = nCol + 1
rHeads.WrapText = True
rHeads.VerticalAlignment = xlVAlignTop
Loop
End Sub
Function Copy_Data_From_RDBMS(rs As Object, nRow As Long) As Long
'Supports Multi Query
If nRow = 1 Then
x = Get_Last_Row_Find(ActiveSheet.Range("E1:ZZ64000"))
ActiveSheet.Range("E2:ZZ" & x).ClearContents
End If
On Error Resume Next
rs.MoveFirst
On Error GoTo 0
If Not rs.EOF Then
ActiveSheet.Range("E2").Offset(nRow - 1, 0).CopyFromRecordset rs
x = Get_Last_Row_Find(ActiveSheet.Range("E1:ZZ64000"))
Copy_Data_From_RDBMS = x + 1
ActiveSheet.Range("E2:ZZ" & x).Offset(nRow - 1, 0).WrapText = False
Else 'no results (e.g. insert)
ActiveSheet.Range("E2").Offset(nRow - 1, 0).Value = "<no data returned>"
End If
rs.Close
Set rs = Nothing
End Function
I have a Excel Sheet(Say OG.xls) which has some data already in it with some 5000 rows with headings in the first row and Upto "AN" Columns.
This No of rows(5000) doesn't change for a whole year.
Now i have 5 XL files(Say A,B,C,D,E) and the data from these files has to be appended to this OG file just starting from 5001st row every time.
All these 5 files has different no of columns but identical to that of OG File.
I have to pull data from these files and place them in OG File.
From File A : Column A,B,C,D,E,F,G&H goes to Column F,G,T,U,V,W,X&Y Of OG.xls File.
Likewise the other files data has to be extracted according to the corresponding column with OG.xls
The second file data has to be appended right below the next row where the File A ends.(Say after filling the data from File A now the OG.xls has 5110 rows,
the File B data has to filled from 5111 st row of OG.xls.
The same follows for the other files too.
The data of these 5 files has to be filled row after row but should match the columns to that of OG.xls
Each time the same operation is repeated by filling the data from 5001st row of OG.xls. For convenience we can have all these files in a same folder.
How can we do this.
Please help me in this!!!
Also let me know for any clarifications.
If you need a more presice answer, you would need to try something first and then ask for help in area you have got stuck. My suggestion is you begin by;
1. Start writing a VBA script in OG.XLS, as a first step try to access the file A.xls and reading the columns and pasting them (they can initially be at any location in any order).
2. Once you are able to do this, next step is to see if you put the data in right column (say 5000 in your example) by setting up right kind of variables and using them and incrementing them.
3. Your next step should be to to read the column headings in A.XLS and finding them OG.XLS and identifying them. Initially you can begin by doing a simple string comparision, later you can refine this to do a VLOOKUP.
4. During this process, if you encounter any specific problem, raise it so that you will get a better answer.
Few from the community would go to the extent of writing the entire code for you.
Why does Column A end up in Column F, and why does C end up in T? Is there a rule around this such as the first row is a header with with the same text in it?
Maybe a picture might help.
Based on what i can guess, i'd throw each sheet into a RecordSet with meaningful field names (you'll need to reference Microsoft ActiveX Data Objects 2.8 Library) . Once done it will be very easy to append each RecordSet and throw them into a single sheet.
You'll need to be able to find the last column and last row in each sheet to do this cleanly so have a look at How can i find the last row...
Edit...
Below is a cleaned up example of how you could do what you need in VBA. The devil is in the details such as empty sheets, and how to handle formulas (this ignores them completely), and how to merge you columns in an appropriate way (again ignored).
This has been tested in Excel 2007.
Option Explicit
Const MAX_CHARS = 1200
Sub MergeAllSheets()
Dim rs As Recordset
Dim mergedRS As Recordset
Dim sh As Worksheet
Dim wb As Workbook
Dim fieldList As New Collection
Dim rsetList As New Collection
Dim f As Variant
Dim cols As Long
Dim rows As Long
Dim c As Long
Dim r As Long
Dim ref As String
Dim fldName As String
Dim sourceColumn As String
Set wb = ActiveWorkbook
For Each sh In wb.Worksheets
Set rs = New Recordset
ref = FindEndCell(sh)
cols = sh.Range(ref).Column
rows = sh.Range(ref).Row
If ref <> "$A$1" Or sh.Range(ref).Value <> "" Then '' This is to catch empty sheet
c = 1
r = 1
Do While c <= cols
fldName = sh.Cells(r, c).Value
rs.Fields.Append fldName, adVarChar, MAX_CHARS
If Not InCollection(fieldList, fldName) Then
fieldList.Add fldName, fldName
End If
c = c + 1
Loop
rs.Open
r = 2
Do While r <= rows
rs.AddNew
c = 1
Do While c <= cols
rs.Fields(c - 1) = CStr(sh.Cells(r, c).Value)
c = c + 1
Loop
r = r + 1
Debug.Print sh.Name & ": " & r & " of " & rows & ", " & c & " of " & cols
Loop
rsetList.Add rs, sh.Name
End If
Next
Set mergedRS = New Recordset
c = 1
sourceColumn = "SourceSheet"
Do While InCollection(fieldList, sourceColumn) '' Just in case you merge a merged sheet
sourceColumn = "SourceSheet" & c
c = c + 1
Loop
mergedRS.Fields.Append sourceColumn, adVarChar, MAX_CHARS
For Each f In fieldList
mergedRS.Fields.Append CStr(f), adVarChar, MAX_CHARS
Next
mergedRS.Open
c = 1
For Each rs In rsetList
If rs.RecordCount >= 1 Then
rs.MoveFirst
Do Until rs.EOF
mergedRS.AddNew
mergedRS.Fields(sourceColumn) = "Sheet No. " & c
For Each f In rs.Fields
mergedRS.Fields(f.Name) = f.Value
Next
rs.MoveNext
Loop
End If
c = c + 1
Next
Set sh = wb.Worksheets.Add
mergedRS.MoveFirst
r = 1
c = 1
For Each f In mergedRS.Fields
sh.Cells(r, c).Formula = f.Name
c = c + 1
Next
r = 2
Do Until mergedRS.EOF
c = 1
For Each f In mergedRS.Fields
sh.Cells(r, c).Value = f.Value
c = c + 1
Next
r = r + 1
mergedRS.MoveNext
Loop
End Sub
Public Function InCollection(col As Collection, key As String) As Boolean
Dim var As Variant
Dim errNumber As Long
InCollection = False
Set var = Nothing
Err.Clear
On Error Resume Next
var = col.Item(key)
errNumber = CLng(Err.Number)
On Error GoTo 0
'5 is not in, 0 and 438 represent incollection
If errNumber = 5 Then ' it is 5 if not in collection
InCollection = False
Else
InCollection = True
End If
End Function
Public Function FindEndCell(sh As Worksheet) As String
Dim cols As Long
Dim rows As Long
Dim maxCols As Long
Dim maxRows As Long
Dim c As Long
Dim r As Long
maxRows = sh.rows.Count
maxCols = sh.Columns.Count
cols = sh.Range("A1").End(xlToRight).Column
If cols >= maxCols Then
cols = 1
End If
c = 1
Do While c <= cols
r = sh.Cells(1, c).End(xlDown).Row
If r >= maxRows Then
r = 1
End If
If r > rows Then
rows = r
End If
c = c + 1
Loop
FindEndCell = sh.Cells(rows, cols).Address
End Function