PDA

View Full Version : Solved: QueryTables Loop Question



jo15765
08-13-2012, 06:27 PM
I am running the below code:

Public Sub SQLImport()
Dim Begin As Date
Dim Finish As Date
Dim databaseName
'
databaseName = Array("One", "Two", "Three")

Begin = Application.InputBox(Prompt:="Please Enter an Start Date.", Title:="Begin Date")
Finish = Application.InputBox(Prompt:="Please Enter an End Date.", Title:="End Date")

For q = LBound(databaseName) To UBound(databaseName)
Call ImportData(CStr(databaseName(q)), CDate(Begin), CDate(Finish))
Next q
End Sub
Public Sub ImportData(databaseName, Begin, Finish)

varConn = "ODBC;DBQ=C:\Test\" & databaseName & "db_rpt.mdb;Driver={Driver do Microsoft Access (*.mdb)}"

varSQL = Here is my SQL statement

With ActiveSheet.QueryTables.Add(Connection:=varConn, Destination:=Range("A1"))
.CommandText = varSQL
.Name = "Query-39008"
.RefreshStyle = xlInsertEntireRows
.FieldNames = True
.PreserveColumnInfo = True
.PreserveFormatting = True
.AdjustColumnWidth = True
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End With
End Sub


The issue that I am having is that each time it cycles thro to the next databse it is placing the data to the right of the previous query. Ideally, what I want to happen is to have each subsequent query appended to the last row with data. However, if that isn't possible, another option (which please chime in and tell me other options also) I can think of is to (if this is possible) have each iteration pull in on a different workbook page, then copy the data from each worksheet onto a cumulative worksheet, and delete the individual worksheets before saving. But I feel that may be writing a whole lot of extra code.

How can I have the above code with each iteration append to the row below the last row with data?

Kenneth Hobs
08-14-2012, 05:13 AM
With ActiveSheet.QueryTables.Add(Connection:=varConn, _
Destination:=Range("A" & Rows.Count).End(xlUp))

jo15765
08-14-2012, 05:32 AM
Changing the Destination Range is still placing each query to the right of the previous one. For example if my 1st query ends in AA, then query two will begin in AB.

Is there a way to have them go below one another?

Kenneth Hobs
08-14-2012, 05:49 AM
You need to give the query a new name each time. You probably don't want it to refresh either.

jo15765
08-14-2012, 06:15 AM
You need to give the query a new name each time. You probably don't want it to refresh either.

How would I set the vba to change the query name each iteration thro the loop?

Kenneth Hobs
08-14-2012, 06:57 AM
Since your are passing the database name, why not use that?

.Name = "Q" & databaseName

jo15765
08-14-2012, 07:03 AM
Since your are passing the database name, why not use that?

.Name = "Q" & databaseName

So simple! I was trying to create a entirely new array, pass variables etc etc.

Even changing the query name each time it is still appending to the right of the previous query?

Kenneth Hobs
08-14-2012, 07:27 AM
You will need to offset one row.


With ActiveSheet.QueryTables.Add(Connection:=varConn, _
Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1))

jo15765
08-14-2012, 11:06 AM
You will need to offset one row.


With ActiveSheet.QueryTables.Add(Connection:=varConn, _
Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1))

Running the above code is still appending beside. For example, query1 runs from A1 to G1, then query two will run from H2 to Z2 then query three runs from AA3 to GG3. So it is offsetting one row, but still not appending below.

Kenneth Hobs
08-14-2012, 12:27 PM
I would need to see your code with my other changes to see what is happening.

For an example:
Sub Test_InsertTableWithStoredSQL()
Dim databaseName() As Variant, cmdText() As Variant, i As Integer
'
databaseName = Array("qOne", "qTwo", "qThree")
cmdText() = Array("Aug94", "Order Subtotals", "Sales by Category")

For i = LBound(databaseName) To UBound(databaseName)
Debug.Print databaseName(i), cmdText(i), Range("A" & Rows.Count).End(xlUp).Offset(1).Address
InsertTableWithStoredSQL "c:\myfiles\edrive\excel\ado\NWind2003.mdb", _
CStr(databaseName(i)), CStr(cmdText(i)), Range("A" & Rows.Count).End(xlUp).Offset(1).Address, _
True
Next i
End Sub

Sub InsertTableWithStoredSQL(mdbPath As String, dbName As String, _
cmdText As String, rngDestination As String, _
Optional bFieldNames = True)

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & mdbPath & ";Mode=ReadWrite;Extended Properties=""" _
, """;Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Datab" _
, "ase Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";J" _
, "et OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Co" _
, "mpact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination:=Range("" & rngDestination & ""))
.CommandType = xlCmdTable
.CommandText = Array(cmdText)
.Name = dbName
.FieldNames = bFieldNames
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = mdbPath
.Refresh BackgroundQuery:=False
End With
End Sub

jo15765
08-15-2012, 07:53 AM
Sorry for the delay got caught up with work and couldn't get back...here is the code that I am running...

Public Sub ...()
Dim databaseName

databaseName = Array("One", "Two", "Three")

For q = LBound(databaseName) To UBound(databaseName)
Call ImportData(CStr(databaseName(q))
Next q
End Sub
Public Sub ImportData(databaseName)

varConn = "ODBC;DBQ=C:\Test\" & databaseName & ".mdb;Driver={Driver do Microsoft Access (*.mdb)}"

varSQL = "SELECT * FROM " & databaseName & ""

With ActiveSheet.QueryTables.Add(Connection:=varConn, Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1))
.CommandText = varSQL
.Name = "Q" & databaseName
.RefreshStyle = xlInsertEntireRows
.FieldNames = True
.PreserveColumnInfo = True
.PreserveFormatting = True
.AdjustColumnWidth = True
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End
End Sub

jo15765
08-22-2012, 05:02 AM
Bump....

Kenneth Hobs
08-22-2012, 05:50 AM
Always use Option Explicit as the first line of your Module.

Try passing the range string as I did.

Public Sub Do_ImportData()
Dim databaseName, q As Variant

databaseName = Array("One", "Two", "Three")

For q = LBound(databaseName) To UBound(databaseName)
ImportData CStr(databaseName(q))
Next q
End Sub

Public Sub ImportData(databaseName)
Dim add As String, varConn As String, varSQL As String
add = Range("A" & Rows.Count).End(xlUp).Offset(1)
varConn = "ODBC;DBQ=C:\Test\" & databaseName & ".mdb;Driver={Driver do Microsoft Access (*.mdb)}"

varSQL = "SELECT * FROM " & databaseName & ""

With ActiveSheet.QueryTables.add(Connection:=varConn, Destination:=Range(add))
.CommandText = varSQL
.Name = "Q" & databaseName
.RefreshStyle = xlInsertEntireRows
.FieldNames = True
.PreserveColumnInfo = True
.PreserveFormatting = True
.AdjustColumnWidth = True
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End With
End Sub

snb
08-22-2012, 06:17 AM
or use:

Sub Access_database_ADO()
' set reference to Microsoft ActveX Data Objects 2.0 Library

With New Recordset
.Open "SELECT * FROM `G:\Access\fiets.mdb`.`tabel1`", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & "G:\Access\fiets.mdb'"
Sheets(1).Cells(20, 1).CopyFromRecordset .DataSource
End With
End Sub


In a more general form:

Sub Access_database_ADO_alg()
' set reference to Microsoft ActveX Data Objects 2.0 Library

c01 = "G:\Access\fiets.mdb"
c02 = "tabel1"

With New Recordset
.Open Replace(Replace("SELECT * FROM `~~`.`~`", "~~", c01), "~", c02), Replace("Provider=Microsoft.Jet.OLEDB.4.0;Data Source='~'", "~", c01)
Sheets(1).Cells(5, 1).CopyFromRecordset .DataSource
End With
End Sub


Or by passing arguments:
Sub Access_database_ADO_common(c01 As String, c02 As String)
' set reference to Microsoft ActveX Data Objects 2.0 Library

With New Recordset
.Open Replace(Replace("SELECT * FROM `~~`.`~`", "~~", c01), "~", c02), Replace("Provider=Microsoft.Jet.OLEDB.4.0;Data Source='~'", "~", c01)
Sheets(1).Cells(5, 1).CopyFromRecordset .DataSource
End With
End Sub

Sub snb_005()
Access_database_ADO_common "G:\Access\fiets.mdb", "tabel1"
End Sub

Kenneth Hobs
08-22-2012, 06:57 AM
I forgot to add the .address for the add. Must be addle-minded from not enough sleep...

add = Range("A" & Rows.Count).End(xlUp).Offset(1).Address

jo15765
08-22-2012, 07:09 AM
Disregard my initial post, I didn't see your amendment above adding in the

add = Range("A" & Rows.Count).End(xlUp).Offset(1).Address


However, on my end this is still appending side by side and not below the previous.

snb
08-22-2012, 07:37 AM
Applied to your question:
NB. I do not know the names of the tables that contain the data you want to import.
I assumed in the code that it is alwasy 'Table1'

Sub snb_005()
for j= 1 to 3
Access_database_ADO_common "C:\test\" & choose(j,"one","two","three") & ".mdb", "table1"
next
End Sub



Sub Access_database_ADO_common(c01 As String, c02 As String)
' set reference to Microsoft ActveX Data Objects 2.0 Library

With New Recordset
.Open Replace(Replace("SELECT * FROM `~~`.`~`", "~~", c01), "~", c02), Replace("Provider=Microsoft.Jet.OLEDB.4.0;Data Source='~'", "~", c01)
thisworkbook.Sheets(1).Cells(rows.count,1).end(xlup).offset(1), 1).CopyFromRecordset .DataSource
End With
End Sub

jo15765
08-22-2012, 07:56 AM
My SQL statement actually just got more advanced today as they changed the structure of what was being asked to be pulled in. Now I am working with 5 different tables.

Pre = "Master_"
tbl1 = Pre & CStr(DatabaseName(q))
tbl2 = "tbl_Name"
tbl3 = "tbl_Owner"
tbl4 = "tbl_main"
tbl5 = "tbl_New"


And my SQL statement is this:

varSQL = "SELECT " & tbl1 & ".CustFname As [First Name]," & tbl1 & ".CustLName As [Last Name]," & tbl1 & ".CustHomeAddress As [Address]," & tbl1 & ".CustCity," & tbl1 & ".CustState," & tbl1 & ".CustZip," & tbl1 & ".CustPhone_Main As [Contact Number]," & tbl1 & ".CustPrimEmail As [Email]," & tbl1 & ".sale_date As [Date of Sale]," & tbl1 & ".EmplNotes As [Employee Notes]," & tbl3 & ".name, ([" & tbl5 & ".itemValue1])+([" & tbl5 & ".itemValue2])+([" & tbl5 & ".itemValue3])+([" & tbl5 & ".itemValue4])+([" & tbl5 & ".itemValue5]) AS [Total Sale Value]," & tbl2 & ".CustSalesRep AS [Sales Associate]" _
& " FROM " & tbl2 & ", " & tbl3 & ", (" & tbl1 & " INNER JOIN " & tbl4 & " ON " & tbl1 & ".sale_date = " & tbl4 & ".sale_date) INNER JOIN " & tbl5 & " ON " & tbl1 & ".CustFname = " & tbl5 & ".CustFname"

Kenneth Hobs
08-22-2012, 08:33 AM
I don't see your last part as being much of a complication other than for us to test. Try using my code with the Northwind database.

Once you see that it can work, you can probably figure out what might be going on with yours. Sometimes, breaking something down to a small bit or working on a clean copy helps clear things up. You may have some parts from previous runs that are gumming things up.

snb
08-22-2012, 10:18 AM
Sub Access_database_ADO_common(d01 As String, d02 As String)
' set reference to Microsoft ActveX Data Objects 2.0 Library

With New Recordset
.Open d01, Replace("Provider=Microsoft.Jet.OLEDB.4.0;Data Source='~'", "~", d02)
ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).CopyFromRecordset .DataSource
End With
End Sub


Sub snb_005()
varSQL = Replace(Replace(Replace(Replace("SELECT ~.CustFname As [First Name],~.CustLName As [Last Name],~.CustHomeAddress As [Address],~.CustCity,~.CustState,~.CustZip,~.CustPhone_Main As [Contact Number],~.CustPrimEmail As [email]~.sale_date As [Date of Sale],~.EmplNotes As [Employee Notes],~~~.name, ([~~~~~.itemValue1])+([~~~~~.itemValue2])+([~~~~~.itemValue3])+([~~~~~.itemValue4])+([~~~~~.itemValue5]) AS [Total Sale Value],~~.CustSalesRep AS [Sales Associate] FROM ~~, ~~~, (~ INNER JOIN ~~~~ ON ~.sale_date = ~~~~.sale_date) INNER JOIN ~~~~~ ON ~.CustFname = ~~~~~.CustFname", String(5, "~"), "tbl_New"), String(4, "~"), "tbl_main"), String(3, "~"), "tbl_Owner"), "~~", "tbl_Name")

For j = 1 To 3
c01 = Choose(j, "first", "second", "third")
c02 = Replace(varSQL, "~", c01)
Access_database_ADO_common c02, "C:\Test\" & c01 & ".mdb"
Next
End Sub

jo15765
08-28-2012, 05:37 AM
Eh, I have tried with blank databases but the import is still appending the data to the right of the previous.

I just ran a make-table query and appended the data into that table, then ran one query off of the make table query to pull into excel.