[]'s can indicate an Excel range, which also means Evaluate in Excel, or a parameter query. I suspect you mean the latter. I will show an example for doing that later. First, I want to show you how to build a string efficiently. Concatenation as you did is fine for small string. This method also makes it easy to maintain. The vbCRLF is the carriage return and line feed characters. Press F1 while in or next to a constant or command word to get specific help in the Visual Basic Editor (VBE).
In the 1st example code, I join the array elements back into a string and delimit by the comma character. I prefer delimiting by the vbCRLF character(s) or vbLF usually.
The 3rd example shows how to run a stored query.
Sub sql()
Dim sSQL As String, s() As String
'SELECT Sum(Data.PBO) As SumOfPBO,
'Sum(Data.AccruedInterest) As SumOfAccruedInterest,
'Sum(IIf([Status]="Claims" Or [Status]="Forbearance",
'[AccruedInterest],IIf([Status]="Repayment",0,
'IIf([SubsidyIndicator]="N",[AccruedInterest],0)))) As ITBC,
'Sum(IIf([ABI]=0,0,[pbo]/[ABI])) As Borr, Count(Data.BorrowerUniqueID) As Loans,
'Sum([PBO]*[RemainingRepaymentTerm])/Sum([PBO]) As RepayTerm,
'Sum([pbo]*[InterestRate])/Sum([PBO]) As IntRate FROM Data LEFT JOIN tbl_ABI ON Data.BorrowerUniqueID = tbl_ABI.BorrowerUniqueID HAVING (((Data.PBO)<>0));
ReDim s(1 To 8)
s(1) = "SELECT Sum(Data.PBO) As SumOfPBO"
s(2) = "Sum(Data.AccruedInterest) As SumOfAccruedInterest"
s(3) = "Sum(IIf([Status]='Claims' Or [Status]='Forbearance'"
s(4) = "[AccruedInterest],IIf([Status]='Repayment',0"
s(5) = "IIf([SubsidyIndicator]='N',[AccruedInterest],0)))) As ITBC"
s(6) = "Sum(IIf([ABI]=0,0,[pbo]/[ABI])) As Borr, Count(Data.BorrowerUniqueID) As Loans"
s(7) = "Sum([PBO]*[RemainingRepaymentTerm])/Sum([PBO]) As RepayTerm"
s(8) = "Sum([pbo]*[InterestRate])/Sum([PBO]) As IntRate FROM Data LEFT JOIN tbl_ABI ON Data.BorrowerUniqueID = tbl_ABI.BorrowerUniqueID HAVING (((Data.PBO)<>0));"
sSQL = Join(s(), ",")
Debug.Print sSQL
MsgBox sSQL
End Sub
'http://www.excelkb.com/article.aspx?id=10091&cNode=1I7C3V
Sub Execute_Parameterized_SQL_Queries()
Dim cnt As ADODB.Connection
Dim cmd As ADODB.Command
Dim prm As ADODB.Parameter
Dim rst As ADODB.RecordSet
Dim stDB As String, stCon As String, stParamSQL As String
Dim vaNumber As Variant
Dim xlCalc As XlCalculation
'Change settings in order to increase the performance.
With Application
xlCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
'Path to the database.
stDB = "E:\Arbetsmaterial\XLData1.mdb"
'Create the connection string.
stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & stDB & ";" & _
"Jet OLEDB:Database Password=dennis;" & _
"Persist Security Info=False"
'Create the parameter string.
stParamSQL = "SELECT * FROM tblData WHERE [Number]=?"
'Instantiate the ADO COM's objects.
Set cnt = New ADODB.Connection
Set cmd = New ADODB.Command
'Open the connection.
cnt.Open stCon
'Set main properties of the command object.
With cmd
.ActiveConnection = cnt
.CommandText = stParamSQL
.CommandType = adCmdText
End With
'Retrieve the value to be used.
vaNumber = Trim(Application.InputBox(Prompt:="Please enter an article number:", _
Title:="Parameterized Queries", Type:=1))
'In the user cancel the operation.
If vaNumber = "False" Then GoTo Exithere
'Create and define the parameter.
Set prm = cmd.CreateParameter("Number", adInteger, adParamInput, Len(vaNumber), vaNumber)
cmd.Parameters.Append prm
'Instantiate the Recordset object and execute the command.
Set rst = cmd.Execute
'Check if the Recordset have any records.
If rst.EOF = True Or rst.BOF = True Then
MsgBox "No records match the number!", vbInformation
GoTo Exithere
Else
'Dump the records into the active worksheet.
With ActiveSheet.Cells(2, 1)
.CurrentRegion.ClearContents
.CopyFromRecordset rst
End With
End If
'Close the recordset and the connection.
rst.Close
cnt.Close
Exithere:
'Release objects from memory.
Set rst = Nothing
Set prm = Nothing
Set cmd = Nothing
Set cnt = Nothing
'Restore the settings.
With Application
.Calculation = xlCalc
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
'http://www.vbaexpress.com/forum/showthread.php?t=24118
'http://www.vbaexpress.com/forum/showthread.php?t=24575
'http://www.vbaexpress.com/forum/showthread.php?t=23783
'http://www.vbaexpress.com/forum/showthread.php?t=26145
Sub Test()
Dim mdbPath As String, dbName As String, cmdText As String
Dim rngDestination As String
'mdbPath = "E:\ADO\NWind2003.mdb" 'change the path here to suit your needs
'mdbPath = "c:\myfiles\edrive\excel\ado\NWind2003.mdb"
mdbPath = "//matpc10/ExcelVBAExamples/ado/NWind2003.mdb"
dbName = "NWind2003_1" 'change the database name here to suit your needs
cmdText = "Aug94" 'change the stored SQL here to suit your needs
rngDestination = "A1" 'change the destination range here to suit your needs
'Clear previous data
Cells.Delete
InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination
'Insert other data to the right of A1 with a blank column separating the two
rngDestination = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 2).Address
cmdText = "Sales by Category"
InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination
End Sub
' http://www.vbaexpress.com/forum/showthread.php?t=43307
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
Reply With Quote
