Solved: QueryTables Loop Question

[jo15765]

I am running the below code:
[vba]
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
[/vba]

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]

[VBA]With ActiveSheet.QueryTables.Add(Connection:=varConn, _
Destination:=Range("A" & Rows.Count).End(xlUp))[/VBA]

[jo15765]

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]

You need to give the query a new name each time. You probably don't want it to refresh either.

[jo15765]

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]

Since your are passing the database name, why not use that?

[VBA].Name = "Q" & databaseName [/VBA]

[jo15765]

Since your are passing the database name, why not use that?

[vba].Name = "Q" & databaseName [/vba]

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]

You will need to offset one row.

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

[jo15765]

You will need to offset one row.

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

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]

I would need to see your code with my other changes to see what is happening.

For an example:
[VBA]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 OLEDBatabase Password="""";Jet OLEDB:Engine Type=5;Jet OLEDBatab" _
, "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 OLEDBon'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
[/VBA]

[jo15765]

Sorry for the delay got caught up with work and couldn't get back...here is the code that I am running...
[vba]
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
[/vba]

[jo15765]

Bump....

[Kenneth Hobs]

Always use Option Explicit as the first line of your Module.

Try passing the range string as I did.

[VBA]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
[/VBA]

[snb]

or use:
[VBA]
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
[/VBA]

In a more general form:

[VBA]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
[/VBA]

Or by passing arguments:
[VBA]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[/VBA]

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

[Kenneth Hobs]

I forgot to add the .address for the add. Must be addle-minded from not enough sleep...

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

[jo15765]

Disregard my initial post, I didn't see your amendment above adding in the
[vba]
add = Range("A" & Rows.Count).End(xlUp).Offset(1).Address
[/vba]

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

[snb]

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'

[VBA]Sub snb_005()

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

[VBA]

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

[/VBA]

[jo15765]

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.
[vba]
Pre = "Master_"
tbl1 = Pre & CStr(DatabaseName(q))
tbl2 = "tbl_Name"
tbl3 = "tbl_Owner"
tbl4 = "tbl_main"
tbl5 = "tbl_New"
[/vba]

And my SQL statement is this:
[vba]
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"
[/vba]

[Kenneth Hobs]

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]

[VBA]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[/VBA]


[VBA]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[/VBA]