Excel VBA - Running SQL script multiple times with different variable value - sql-server-2008

I want to run a script in my macro multiple times by changing variable values.
Below is an example of my code that I run for one value.
The line of code I would like to change is
sScript = sScript + "where m.outletid in ('" & sOutletId & "') " & vbCrLf
Sometime I want the where clause to be
where m.outletid in ('12314')
or
where m.chainid in ('411')...
Code:
Sub Report()
Dim sScript As String
Dim sServer As String
Dim sDatabase As String
Dim sTransTable As String
Dim iVal As Integer
Dim iReturnVal As Integer
Dim SheetExists As Worksheet
Dim WK_SHEET As String
sServer = Trim(UserForm1.txtServer.Value)
sDatabase = Trim(UserForm1.txtDatabase.Value)
sTransTable = Trim(UserForm1.txtTransTable.Value)
For Each SheetExists In Worksheets
If SheetExists.Name = ("Report") Then
Application.DisplayAlerts = False
Sheets("Report").Delete
Application.DisplayAlerts = True
Exit For
End If
Next SheetExists
Worksheets.Add after:=Sheets("Sheet1")
ActiveSheet.Name = ("Report")
WK_SHEET = "Report"
Sheets(WK_SHEET).Select
sOutletId = "12314"
sScript = "Select top 10 m.CustNumber, m.Name, sum(t.Transvalue) " & vbCrLf
sScript = sScript + "from " & sTransTable & " t " & vbCrLf
sScript = sScript + "where m.outletid in ('" & sOutletId & "') " & vbCrLf
sScript = sScript + "Group by m.CustNumber, m.Name " & vbCrLf
sScript = sScript + "order by sum(t.Transvalue)Desc " & vbCrLf
iReply = MsgBox(Prompt:="Do you wish to continue with the following script for Top 10 Customers?" + sScript + "", _
Buttons:=vbYesNo, Title:="Run MACRO Top 10 Reports")
If iReply = vbNo Then
End
End If
iVal = execute_sql_select(WK_SHEET, 2, 1, sServer, sDatabase, sScript)
Sheets(WK_SHEET).Name = "Outlet" & sOutletId & "Top 10 by Spend"
Now I would like to re run the above with OutletId 12315...how can I do this? Do I use some sort of loop?

You can keep list of OutletId into Array. Then get each OutletId from Array (for loop) and execute your sql script.
Pseudu code
Array listOutid = new Array[12,13,14,15];
for(int idx = 0; idx < listOutid.Length; idx++)
{
var OutletId = listOutid[idx];
//put ur sql statement and execute here..
}

Related

Access VBA Parameter Query Changes Integer to String

Okay, I need help resolving what should be an easy issue. I am trying to do an UPDATE query to an Access table. I have the ID of the record to be updated in a hidden text box on my form. What happens is that the query def changes my Integer to a string when it stores it in the parameter. It does this even after I cast the value to an Integer. p6 is the parameter name. See code below. I get a data type mismatch error on every other field that has an integer value as well.
Private Sub SubmitButton_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strSql As String
Dim frm As Object
If IsRequiredFilled(Me) = False Then
MsgBox "Please fill out all required fields.", vbCritical
Exit Sub
End If
Set db = CurrentDb
strSql = "UPDATE [Batches_T] " & _
"SET [BatchName] = [BatchName] + [p1], " & _
"[StatusID] = [StatusID] + [p2], " & _
"[InternalStatusID] = [InternalStatusID] + [p2], " & _
"[ReviewerID] = [ReviewerID] + [p3], " & _
"[StartDate] = [StartDate] + [p4], " & _
"[PowerPointFilePath] = [PowerPointFilePath] + [p5] " & _
"WHERE [ID] = [p6]"
Set qdf = db.CreateQueryDef(vbNullString, strSql)
With qdf
.Parameters("p1").Value = Me.BatchName
.Parameters("p2").Value = Me.StatusID
.Parameters("p3").Value = Me.InternalStatusID
.Parameters("p4").Value = Me.StartDate
.Parameters("p5").Value = Me.PowerPointFilePath
.Parameters("p6").Value = CInt(Me.ID)
.Execute dbFailOnError
End With
Set qdf = Nothing
Set db = Nothing
Forms![Dashboard_F]![Batches_DS_F].Requery
If Me.keepOpenCheckBox = False Then
DoCmd.Close acForm, "AddBatch_F", acSaveYes
End If
End Sub
Try and add explicit type declarations for the parameter:
strSql = "PARAMETERS [p6] INTEGER; " & _
"UPDATE [Batches_T] " & _
"SET [BatchName] = [BatchName] + [p1], " & _
"[StatusID] = [StatusID] + [p2], " & _
"[InternalStatusID] = [InternalStatusID] + [p2], " & _
"[ReviewerID] = [ReviewerID] + [p3], " & _
"[StartDate] = [StartDate] + [p4], " & _
"[PowerPointFilePath] = [PowerPointFilePath] + [p5] " & _
"WHERE [ID] = [p6]"

parsing database columns and values to MySQL statement in module

I'm trying to create a dynamic MySQL INSERT INTO...WHERE NOT EXIST statement by parsing the table name, array of columns, array of values and conditional column and value to a subroutine in a separate module but i keep hitting the Column count doesn't match value count at row 1 error. Below is the code:
Sub InsertRecord(ByVal tbl As String, ByVal cols() As String, ByVal params() As String, _
ByVal colCondition As String, ByVal paramCondition As String) 'As String
'Create new string of columns
Dim myCols As String = ""
For Each col As String In cols
myCols &= col & ", "
Next
Dim newCols As String = myCols.Remove(myCols.Count - 2, 2)
MsgBox(newCols)
Dim scols As String = newCols.Insert(0, "`").Replace(", ", "`, `") & "`"
MsgBox(scols)
'Create new string of parameters
Dim myParams As String = ""
For Each param In params
myParams &= param & ", "
Next
Dim newParams As String = myParams.Remove(myParams.Count - 2, 2)
MsgBox(newParams)
Dim sparams As String = newParams.Insert(0, "'").Replace(", ", "', '") & "'"
MsgBox(sparams)
'End
Dim p As String = paramCondition.Insert(0, "'") & "'"
'Try
'Dim insRemarks As String = "done"
con = New MySqlConnection("Server=localhost; Database=etms; Uid=root; Pwd=;")
comA = New MySqlCommand
'INSERT NEW RECORD.
'THIS GIVES THE ERROR
comA.CommandText = "INSERT INTO " & tbl & " (" & scols & ") SELECT * FROM (SELECT #params) AS tmp "
comA.CommandText &= "WHERE NOT EXISTS (SELECT " & colCondition & " FROM " & tbl & " WHERE " & colCondition & " = #param) limit 1"
comA.Parameters.AddWithValue("#param", p)
comA.Parameters.AddWithValue("#params", sparams)
'THIS STATIC CODE WORKS FINE.
'comA.CommandText = "INSERT INTO state (`st_state`, `ctry_Id`) SELECT * FROM (SELECT 'a', '1') AS tmp "
'comA.CommandText &= "WHERE NOT EXISTS (SELECT st_state FROM state WHERE st_state = 'a') limit 1"
comA.Connection = con
con.Open()
comA.ExecuteNonQuery()
con.Close()
'Release used up components
comA.Parameters.Clear()
comA.Dispose()
comA = Nothing
con = Nothing
MsgBox("done.")
'Return insRemarks
'Catch ex As Exception
'MsgBox(ex.Message.ToString & vbCrLf & vbCrLf & comA.CommandText.ToString)
'Return "Error"
'End Try
End Sub
As seen, i tried a lot of permutations (introducing inverted quotation marks) to no avail.
I'll be glad if someone could help out.

Hints to determine which combo boxes were selected?

I have 8 combo boxes in an Access database. Each combo box can either have a value or not have a value (2 options). In total, there can be 256 combinations (2^8). I am trying to create some code in VBA that loops through these combinations to determine which combination currently exists, with the ultimate goal of writing an SQL query within VBA based on that combination. So for example, let's say combo1 and combo2 both have selections, but not combo3 through combo8. If that is the combination I would like my SQL query to do a SELECT FROM query WHERE a column in db = combo1 and a column in db = combo2. Can anyone provide hints as to how I would structure my code?
Thanks!
Dim a as string, b as string
const myAND as string = "AND "
a = ""
a = "SELECT * FROM a table "
b = ""
if cbo1.value <> "" then
b = b & myAND & "AND field1 = '" & cbo1.value & "'"
end if
if cbo2.value <> "" then
b = b & myAND & "field2 = '" & cbo2.value & "'"
end if
etc for each cbo box
If b <> "" Then
' Lazy way
' a = a & "WHERE 1=1 " & b
' remove the first AND way
a = a & "WHERE 1=1 " & mid(b,len(myAND))
End if
' a now contains the SQL you need.
Dim where_condtion as String
Dim sqlquery as String
where_condtion = ""
IF combo1 <>"" then
where_condtion = where_condtion + "~fieldname~ = " & combo1
End IF
IF combo2 <>"" then
where_condtion = where_condtion + "AND ~fieldname~ = " & combo2
End IF
*
*
*
IF combo8 <>"" then
where_condtion = where_condtion + "AND ~fieldname~ =" & combo8
End IF
IF where_condtion <> "" then
sqlquery = "Select * from ~table name~ where" + where_condtion
ELSE
sqlquery = "Select * from ~table name~
End IF
sqlquery = Replace(sqlquery, "where AND ", "where ")
DoCmd.OpenQuery "sqlquery", acViewNormal, acEdit
OR
CurrentDb.OpenRecordset("sqlquery")
Am option would be a concatenated string
Code Example
Dim strSQL as String
'basic string
strSQL = "SELECT tbl.fieldA, tbl.fieldB FROM tbl "
Dim strSQLwhere as String
strSQLwhere = ""
'Combobox cmbbox1
If Not isNull(cmbbox1) And cmbbox1.ListIndex <> -1 then
strSQLwhere = strSQLwhere & "tbl.fieldToFilter1=" & cmbbox1
End if
'Combobox cmbbox2
If Not isNull(cmbbox2) And cmbbox2.ListIndex <> -1 then
iF NOT strSQLwhere = "" then
strSQLwhere = strSQLwhere & " AND "
end if
strSQLwhere = strSQLwhere & "tbl.fieldToFilter2=" & cmbbox2
End if
'And so on until cmbBox 8
'Combine all Strings
if not strSQLwhere = "" then
strSQL = strSQL & " WHERE (" & strSQLwhere & ")"
End if
'Add here further thing like ORDER BY, GROUP BY
'Show SQL sting if it is well fomratted, change string concatenation if not
debug.print strSQL
You could do the combobox if-then-(else) cases in a separate function if you are able to do that in VBA.

Access "Runtime error 3464" Data type mismatch in criteria expression

Upon clicking a drop down menu and section of an entry that I have put in there, I get runtime error 3464 which is data type mismatch and stops at Set rsrecall = dbsrecall.OpenRecordset(strSQLWork)
What am I missing here?
Dim dbsrecall As DAO.Database
Dim rsrecall As DAO.Recordset
Dim intRecCnt As Integer
On Error GoTo Err_Click
strSQLWork = "SELECT tblAB.ID, .,.(lots)...., FROM tblAB WHERE tblAB.Title = " & Me.cmbGetRecall & " ORDER BY tblAB.CreationDate, tblAB.SolutionTarget, tblAB.StartDate;"
Set dbsrecall = CurrentDb()
Set rsrecall = dbsrecall.OpenRecordset(strSQLWork)
rsrecall.MoveFirst
ReDim arrRecall(1, 70)
arrRecall(1, 1) = rsrecall!abc
arrRecall(1, 2) = rsrecall!def
.
.(contd.)
.
arrRecall(1,70) = rsrecall!xyz
Me.txtTitle.SetFocus
Me.lblRecall.Visible = False
Me.cmbGetRecall.Visible = False
Me.txtqwe = arrRecall(1, 4)
Me.txtrty = arrRecall(1, 5)
Me.txtuio = arrRecall(1, 6)
.
.(contd.)
.
me.txtghj = arrRecall(1,70)
Exit Sub
Err_Click:
resp = MsgBox("No records were found for this selection." & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "Please try again.", vbOKOnly)
Me.cmbSol = ""
Me.cmbSol.SetFocus
try
strSQLWork = " SELECT tblAB.ID, .,.(lots)...., FROM tblAB " & _
" WHERE tblAB.Title = '" & Me.cmbGetRecall & "'" & _
" ORDER BY tblAB.CreationDate, tblAB.SolutionTarget, tblAB.StartDate;"

Populate multiple textboxs from openrecordset on Access form

I am trying to populate multiple textboxs from an openrecordset and getting the following error
Run-Time error 3601
Too few parameters. Expected 1
Here is my function
Function fnSearchAndPopulate() As Boolean
Dim d As DAO.Database, r As DAO.Recordset, strSQL As String
Set d = CurrentDb
If Me.txtEnterNumber = "" Then
MsgBox "Please Enter Number", , "Error"
Exit Function
End If
strSQL = "SELECT * FROM amipartnumbers Inner Join jdsubs on amipartnumbers.oemitem=jdsubs.oempartnumber WHERE " & txtEnterNumber.Value & " In (jdsubs.oempartnumber, jdsubs.oemsubnumber)"
Set r = d.OpenRecordset(strSQL)
If r.EOF Then
MsgBox "BAM # " & Me.txtEnterNumber & " does not exist!", , "No BAM #"
Set d = Nothing
Exit Function
End If
'get here if there is a record
r.MoveFirst
'populate whatever textboxes
Me.txtAMINumber = r!Item
Me.txtDescription = r!Description
Me.txtOEMsubnumber = r!OEMsubnumber
Set d = Nothing
Exit Function
End Function
Updated for non-numeric part numbers...
strSQL = " SELECT * FROM amipartnumbers Inner Join jdsubs on " & _
" amipartnumbers.oemitem=jdsubs.oempartnumber WHERE " & _
" jdsubs.oempartnumber= '" & txtEnterNumber.Value & "' or " & _
" jdsubs.oemsubnumber= '" & txtEnterNumber.Value & "'"