Execute sql complex query through excel vba - excel

Just to give you background of my work, i have to fetch data from MS Sql on daily basis and for that every time have to go to other server to run the query. Once the query is executed, have to paste into my common drive, which takes a lot time. ~55 mins to paste 5,00,000 row & 30 fields to common or to move file. In total 2 hours for execution & movement from one location to other.
To reduce this i would need your help to use the SQL queries through excel with the below things:
If possible,
Point1: Query will be stored in the text file in the common location
Point2: Query Parameter to be populate to get
Or
Point2:Range to be defined for parameter
If not possible above,
Query will be pasted into the code and parameter to be populated based on the above mentioned suggestion.
Connection type is windows authentication, it will work based on logged in users windows name.

This code will allow you to provide variables that you use within your SQL statement and put those into cells on a spreadsheet (In this case Cred2) and return the results on a separate sheet (Sheet2).
The first portion of the code establishes a connection with the SQL server.
The column Headers will be started in Row 2 and then the data will begin populating starting on row 3. I have used this to pull well over 100,000 records at a time and this works very quickly.
Private Sub CommandButton1_Click()
Dim cn As Object
Dim rs As Object
Dim strCon As String
Dim strSQL As String
strCon = "DRIVER=SQL Server;SERVER=ServerName;DATABASE=DBName;Trusted_Connection=True"
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
' if not a trusted connection you could replace top line of strCon with
strCon = "DRIVER=SQL Server; Server=myServerAddress;Database=myDataBase;User Id=myUsername; Password=myPassword"
' set up where you are getting your variables to include in the SQL statement
stat = Sheets("Cred2").Range("c7").Value
barg = Sheets("Cred2").Range("c10").Value
worksite = Sheets("Cred2").Range("c11").Value
' Construct SQL statement
strSQL = "select * " _
& " FROM tableName A , table2 B " _
& "WHERE A.[field1] = B.[field1] " _
& " and field1 like '" & stat & "'" _
& "and field2 like '" & barg & "'" _
& "and field3 like '" & worksite & "'" _
& " order by Field? "
' Build Record Set
Set rs = CreateObject("ADODB.RECORDSET")
rs.ActiveConnection = cn
rs.Open strSQL
' Display Data
For intColIndex = 0 To rs.Fields.Count - 1
Sheet2.Range("A2").Offset(0, intColIndex).Value = rs.Fields(intColIndex).name
Next
Sheet2.Range("A3").CopyFromRecordset rs
' Close Database
rs.Close
cn.Close
Set cn = Nothing
end sub

Related

Is there any way of automating certain query execution and storing the O/P of that query in a excel file?

I have around 80 queries which I execute on a daily basis for monitoring purpose. All of them being SELECT queries, we capture the mostly the counts. This is turning out to be a boring task that's just running the query and manually capturing the output in an excel file.
For example, these are my queries with their sample respective outputs:
Query#1: SELECT count(*) from table WHERE certain_condition = 'True'
OUTPUT: 985
Query#2: SELECT count(*) from another_table WHERE yet_another_condition = 'True'
OUTPUT: 365
…
Query#80: SELECT count(*) from another_table WHERE yet_another_condition = 'True'
OUTPUT: 578
My requirement is this:
Capture the output of these 80 queries and paste them in an excel file in a certain order.
In Excel, I'll already have a heading (condition) in a cell. So I want the output of each query to be mapped to a specific cell corresponding to the heading (condition).
Is there any way of automating this boring task, or am I stuck for eternity as a bot?
PS: I am using Toad for Oracle v 12.9.0.71 database
Like Tim was saying ADO is your best bet here. Lucky for you I just had to do this myself so hopefully this should work for you.
Sub SQLQuery(sqlServer As String, strDatabase As String, strQuery As String, _
exportLocation As Variant, strUserId As String, strPassword As String)
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set conn = Nothing
Set rs = Nothing
'create the Connection and Recordset objects
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
'open the connection
conn.Open _
"Provider=SQLOLEDB;" & _
"Data Source=" & sqlServer & ";" & _
"Initial Catalog=" & strDatabase & ";" & _
"User ID=" & strUserId & ";" & _
"Password=" & strPassword & ";" & _
"Trusted_Connection=" & "True" & ";"
'execute
Set rs = conn.Execute(strQuery)
'check if data exists
If Not rs.EOF Then
'if so, copy to location
exportLocation.CopyFromRecordset rs
'close the recordset
rs.Close
End If
'clean up
conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub
An example of using this subroutine:
Call SQLQuery( _
oSERVER, _
oDB, _
"SELECT count(*) from table WHERE certain_condition = 'True'", _
ThisWorkbook.Sheets("Sheet1").Cells(1, 1), _
oUSER, _
oPW)
Just for reference you will likely have to enable Microsoft ActiveX Data Objects 2.8 Library in your References for this to work.

index a library then search for a word in the library and record all possible matches

I have a database of about 400,000 records and would like to search the index result of these to another column to check if it exists or not. I would like it to record even if only a partial string exists. I have an example I have tried in Excel. It takes a very long time to process 100,000 records (4 hours) with 4 cores at 2.8ghz. I figured doing this in MS Access will be faster. Can this be done faster in MS Access? I will paste the code here...
=INDEX($A:$A,AGGREGATE(15,7,ROW($A:$A)/(ISNUMBER(SEARCH($C2,$A:$A))),COLUMN(A:A)))
Is there a way to do this in MS Access with VBA code or a query.
Yes, it can be done although I am not sure it will be faster. Have a table of the library strings and another table for the database strings.
Option using queries requires a unique identifier field in each table. The text strings might serve for that purpose but I recommend a number. If not already in each table add an autonumber field.
Consider:
Query1: LibDB
SELECT [DB_ID]+[LIB_ID] AS ID, DB.WordDB, Lib.WordLib
FROM Lib, DB
WHERE (((InStr([WordLib],[WordDB]))>0))
ORDER BY DB.WordDB, Lib.WordLib;
Query2
TRANSFORM First(LibDB.WordLib) AS FirstOfWordLib
SELECT LibDB.WordDB
FROM LibDB
GROUP BY LibDB.WordDB
PIVOT DCount("*","LibDB","WordDB='" & [WordDB] & "' AND ID<" & [ID])+1;
This is very fast with sample data provided but may perform so slowly with large dataset as to be non-functional.
For a VBA approach, create a table Result with fields named WordDB, F1, F2, etc. Include as many Fn fields as might be needed up to 254. Then procedure in a general module like:
Sub StringMatch()
Dim rsDB As DAO.Recordset, rsLIB As DAO.Recordset, rsRST As DAO.Recordset, n As Integer
Set rsDB = CurrentDb.OpenRecordset("SELECT WordDB FROM DB ORDER BY WordDB")
Set rsRST = CurrentDb.OpenRecordset("SELECT * FROM Result WHERE 1=1")
n = 1
CurrentDb.Execute "DELETE FROM Result"
Do While Not rsDB.EOF
rsRST.AddNew
Set rsLIB = CurrentDb.OpenRecordset("SELECT WordLib FROM Lib " & _
"WHERE InStr([WordLib],'" & rsDB!WordDB & "') > 0 ORDER BY WordLib;")
rsRST!WordDB = rsDB!WordDB
Do While Not rsLIB.EOF And n < 255
rsRST("F" & n) = rsLIB!WordLib
n = n + 1
rsLIB.MoveNext
If rsLIB.EOF Then
rsRST.Update
n = 1
End If
Loop
rsLIB.Close
rsDB.MoveNext
Loop
End Sub
Regardless of method, output is limited to 255 columns.
If you want to stay with Excel, open recordsets of column data and feed results to cells. No idea if this will be faster than your Excel function or Access.
Dim rsLIB As New ADODB.Recordset, rsDB As New ADODB.Recordset, c As Integer, r As Integer
Dim cnx As New ADODB.Connection
'setup the connection
'[HDR=Yes] means the Field names are in the first row
cnx.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source='" & ThisWorkbook.FullName & "';" & _
"Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
rsDB.Open "SELECT Database FROM [Sheet1$] WHERE NOT Database Is Null", _
cnx, adOpenDynamic, adLockOptimistic
c = 3
r = 2
Do While Not rsDB.EOF
rsLIB.Open "SELECT Library FROM [Sheet1$] " & _
"WHERE InStr([Library],'" & rsDB!Database & "')>0 ORDER BY Library", _
cnx, adOpenDynamic, adLockOptimistic
Do While Not rsLIB.EOF
Worksheets("Sheet1").Cells(r, c).Value = rsLIB!Library
rsLIB.MoveNext
c = c + 1
Loop
c = 3
rsLIB.Close
r = r + 1
rsDB.MoveNext
Loop

Get Data From Access Database with Excel VBA

I am having trouble getting data from an Access Database. I found this code online, and it seems to work (to an extent), but for some reason it will only pull the column headers, and none of the data from the query. I am not too familiar with Access, that is why I pulled one from offline.
Someone had a similar post a while back, where the code they used was the same, and our queries were exactly the same, but we had different issues.
Importing Data From Access Using Excel VBA
Would anyone happen to know why the data won't pull?
Sub getDataFromAccess()
Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
Dim startdt As String
Dim stopdt As String
Dim refresh
refresh = MsgBox("Start New Query?", vbYesNo)
If refresh = vbYes Then
Sheet1.Cells.Clear
startdt = Application.InputBox("Please Input Start Date for Query (MM/DD/YYYY): ", "Start Date")
stopdt = Application.InputBox("Please Input Stop Date for Query (MM/DD/YYYY): ", "Stop Date")
DBFullName = "X:\MyDocuments\CMS\CMS Database.mdb"
' Open the connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect
Set Recordset = New ADODB.Recordset
With Recordset
Source = "SELECT * FROM Tracking WHERE [Date_Logged] BETWEEN " & startdt & " AND " & stopdt & " ORDER BY [Date_Logged]"
.Open Source:=Source, ActiveConnection:=Connection
For Col = 0 To Recordset.Fields.Count - 1
Range(“A1”).Offset(0, Col).Value = Recordset.Fields(Col).Name
Next
Range(“A1”).Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
End Sub
An easy way to get data in Excel, especially from Access, is to use the menu "Data > Access". This creates a connection to a table, that you can freely edit.
At the very least, that is a convenient way to limit your investigations to:
the query you typed (the connection string will always be OK, so if you're getting no values, it comes from the query)
or the VBA itself (if the table is returning values but not the corresponding VBA Sub, then you know it comes from the VBA itself, not the SQL).
I'm skipping the creation of connection becuse it's really straightforward; it's better to focus on what you can do once the table has been created.
Edit the connection
When you select the table and go to menu "Data > Properties", then in the window you click on the top right button "Connection properties", you get to the definition of the connection, i.e. some properties in the first tab and the actual definition in the second tab.
If you move the .mdb file, you'll have to change the connection string accordingly. There should be no other events forcing you to alter it.
If you want to type an actual complex query, you'll need to:
Change the command type from "Table" to "SQL"
Type the query in the bottom edit box.
Note if you want to define dynamic parameters in the WHERE clause, you can put question marks (?) instead of hardcoded values. Question marks can be linked to either constants (with a prompt to change their values) or cell.
Use in VBA
Once you checked with the connection that everything works, you have 2 solutions to put that in VBA.
Either use exactly the code you have above; in that case, you can make things easy by simply copying the connection string and the query.
Alternatively and this is what I would recommend, the table we have built previously can be updated very easily in VBA.
Use this piece of code:
WorksheetWithTable.ListObjects(1).QueryTable.Refresh
You really don't need more than this 1 line of code to do the refresh.
If you set your query to automatically refresh when a cell's value is being modified, then you do not even need it at all.
Note #1: Instead of an index in .ListObjects(1), you can use the table name.
Node #2: Refresh has an optional parameters to drive if the query is to be refresh in the background. True means the VBA code will not wait for the execution to end before moving to the next instruction. False, obviously, is the opposite.
The posted code is missing End If line. Perhaps this is just a posting typo because code should not compile and run.
The query SQL needs # delimiters for the date parameters:
Source = "SELECT * FROM Tracking WHERE [Date_Logged] BETWEEN #" & startdt & "# AND #" & stopdt & "# ORDER BY [Date_Logged]"
Text field would need apostrophe delimiters. Number field does not need delimiters.
I solved the answer to my own question after hours, i found a different set of code that worked fine. Thank you all for your help!
Sub getdatamdb()
Dim cn As Object, rs As Object
Dim intColIndex As Integer
Dim DBFullName As String
Dim TargetRange As Range
10 DBFullName = "X:\MyDocuments\CMS\CMS Database.mdb"
20 On Error GoTo Whoa
30 Application.ScreenUpdating = False
40 Set TargetRange = Sheets("Sheet1").Range("A1")
50 Set cn = CreateObject("ADODB.Connection")
60 cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
70 Set rs = CreateObject("ADODB.Recordset")
80 rs.Open "SELECT * FROM Tracking WHERE [Date_Logged] BETWEEN #" & startdt & "# AND #" & stopdt & "# ORDER BY [Date_Logged]", cn, , , adCmdText
' Write the field names
90 For intColIndex = 0 To rs.Fields.Count - 1
100 TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
110 Next
' Write recordset
120 TargetRange.Offset(1, 0).CopyFromRecordset rs
LetsContinue:
130 Application.ScreenUpdating = True
140 On Error Resume Next
150 rs.Close
160 Set rs = Nothing
170 cn.Close
180 Set cn = Nothing
190 On Error GoTo 0
200 Exit Sub
Whoa:
210 MsgBox "Error Description :" & Err.Description & vbCrLf & _
"Error at line :" & Erl & vbCrLf & _
"Error Number :" & Err.Number
220 Resume LetsContinue
End If
End Sub

How to merge two tables from two different work sheets into one final table with different columns?

I am very new to coding (a newbie).
At work place, I have following to do:
A) I have Table A
B) I have Table B
C) I need output Table C (how do I get it?)
I am describing in details here:
Input Tables A and B:
Output Table C:
I have to get Output table C for many many files and thus will be very difficult to match up Order and Order-1 in the Tables using copy and past option in excel.
Thanks a ton for looking into this.
Apologies if the question is not clear.
Please let me know if you need any further information regarding this.
You can try taking a UNION of the two tables:
SELECT Time, Type, User, '', Order-1, Urea
FROM TableA
UNION ALL
SELECT Time, '', User, Order, Order-1, Urea
FROM TableB
ORDER BY Time
If you're not really using MySQL, then you should not have tagged your question as such, which generated an answer like this one.
this is Vba of SQL. practice sub myQuery.
Dim Ws As Worksheet
Dim strSQL As String
Sub myQuery()
Set Ws = Sheets("C")
strSQL = "SELECT Time, Type, User, '' as [Order], [Order-1], Urea"
strSQL = strSQL & " FROM [A$] where not isnull(Time) "
strSQL = strSQL & " Union All "
strSQL = strSQL & "SELECT Time, '', User, [Order], [Order-1], Urea "
strSQL = strSQL & "FROM [B$] where not isnull(time) "
strSQL = strSQL & "ORDER BY Time "
DoSQL
End Sub
Sub DoSQL()
Dim Rs As Object
Dim strConn As String
Dim i As Integer
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=Excel 12.0;"
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open strSQL, strConn
If Not Rs.EOF Then
With Ws
.Range("a1").CurrentRegion.Clear
For i = 0 To Rs.Fields.Count - 1
.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next
.Range("a" & 2).CopyFromRecordset Rs
.Columns(1).NumberFormatLocal = "[$-409]mm/dd/yy h:mm AM/PM;#"
End With
End If
Rs.Close
Set Rs = Nothing
End Sub

Excel sheet export to Access via ADODB inconsistent behavior

I am experiencing an odd behavior when I'm exporting an Excel spreadsheet into a Access database via ADODB. The Office version is 2013 32bit running on Win7 64bit. These are the steps:
I have created a new Access file called 'test.accdb' with just one table 'orders' and one field 'OrderID'. The table is empty.
I have created a new .csv file, orders.csv. Later I show the content of this file and the end result.
I have an Excel addin with the following macro:
Public Sub updateAccess()
Dim con As New ADODB.Connection
Dim connectionString As String
Dim rs As New ADODB.Recordset
Dim sql As String
Dim Filename As String
Filename = Application.ActiveWorkbook.Path & "\test.accdb"
connectionString = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};DBQ=" & Filename
connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Filename
Call con.Open(connectionString)
sql = "DELETE FROM orders"
Call con.Execute(sql)
sql = "INSERT INTO orders " & _
"SELECT * FROM [Excel 12.0 Xml;HDR=YES;DATABASE=" & _
ActiveWorkbook.FullName & "].[" & ActiveWorkbook.Sheets(1).Name & "$]"
Set rs = con.Execute(sql)
Call con.Close
Set con = Nothing
End Sub
I then open the order.csv file using Excel, run the macro and then open test.accdb using Access. Depending on the content of the csv file, different results are output:
Case A
orders.csv:
OrderID
1
A
test.accdb, in table 'orders':
OrderID
1
A
Case B
orders.csv:
OrderID
1
A
3
test.accdb, in table 'orders'
OrderID
<blank>
1
3
Case C
orders.csv:
OrderID
1
A
3
B
C
D
test.accdb, in table 'orders'
OrderID
1
3
A
B
C
D
Why is case B failing?
I can't wrap my head around it. I tried two drivers, but no luck.
ADODB with an Excel database will guess the field types from the first 16 records. In the case
OrderID
1
A
3
it will guess numeric field type since numeric is in majority.
To avoid this, you can use the IMEX parameter within the connection string, see: https://www.connectionstrings.com/excel/
So with your code:
...
sql = "INSERT INTO orders " & _
"SELECT * FROM [Excel 12.0 Xml;HDR=YES;IMEX=1;DATABASE=" & _
ActiveWorkbook.FullName & "].[" & ActiveWorkbook.Sheets(1).Name & "$]"
Set rs = con.Execute(sql)
...

Resources