The Following code returns a stored procedure with a hard value coded. I need to allow 74 to change to whatever is selected from a combo box. Any help is greatly appreciated. I am using a pass through query in Access.
Private Sub ok_Click()
Dim objConnection As New ADODB.Connection
Dim objCom As ADODB.Command
Dim provStr As String
Set objCom = New ADODB.Command
objConnection.Provider = "sqloledb"
provStr = "Data Source=**;" & "Initial Catalog=IKB_QA;User Id=**;Password=**;"
objConnection.Open provStr
With objCom
.ActiveConnection = objConnection
.CommandText = "dbo.ix_spc_planogram_match 74"
.CommandType = adCmdStoredProc
.Execute
End With
End Sub
You can use the command object's parameter fields for a neater approach:
With objCom
.ActiveConnection = objConnection
.CommandText = "dbo.ix_spc_planogram_match"
.CommandType = adCmdStoredProc
.Parameters.Refresh
.Parameters(1).Value = ComboBox1.Value
.Execute
End With
The following code grabs parameter from form and executes the stored procedure.
Dim Cmd1 As ADODB.Command
Dim lngRecordsAffected As Long
Dim rs1 As ADODB.Recordset
Dim intRecordCount As Integer
'-----
Dim cnnTemp As ADODB.Connection
Set cnnTemp = New ADODB.Connection
cnnTemp.ConnectionString = "DRIVER=SQL Server;SERVER=***;" & _
"Trusted_Connection=No;UID=***;PWD=***;" & _
"Initial Catalog=IKB_QA;"
cnnTemp.ConnectionTimeout = 400
'Open Connection
cnnTemp.Open
Set Cmd1 = New ADODB.Command
Cmd1.ActiveConnection = cnnTemp
'---
With Cmd1
Dim localv As Integer
Dim inputv
localv = [Forms]![start]![Selection]![cat_code]
.CommandText = "dbo.ix_spc_planogram_match " & inputv
.CommandType = adCmdStoredProc
Set inputv = Cmd1.CreateParameter("#catcode", 3, 1, 10000, localv)
Cmd1.Parameters.Append inputv
Set rs1 = Nothing
Set rs1 = Cmd1.Execute
localv = 0
Do While Not rs1.EOF
Debug.Print rs1.Fields.Item("POG_DBKEY").Value = "POG_DBKEY"
Debug.Print rs1.Fields.Item("COMP_POG_DBKEY").Value = "COMP_POG_DBKEY"
Debug.Print rs1.Fields.Item("CURR_SKU_CNT").Value = "CURR_SKU_CNT"
Debug.Print rs1.Fields.Item("COMP_SKU_CNT").Value = "COMP_SKU_CNT"
Debug.Print rs1.Fields.Item("SKU_TOTAL").Value = "SKU_TOTAL"
Debug.Print rs1.Fields.Item("MATCHD").Value = "MATCHD"
localv = localv + 1
rs1.MoveNext
Loop
localv = localv
rs1.Close
Set rs1 = Nothing
Set rs1 = Nothing
End With
End Sub
You can try this concatenation:
replace your statement:
.CommandText = "dbo.ix_spc_planogram_match 74"
with:
.CommandText = "dbo.ix_spc_planogram_match " & yourComboBox.Text
Assuming the combo box name is yourComboBox
Related
I am trying to fill my 31 textboxes with one single recordset containing 31 days (from Jan 1st to Jan 31st).
While it's clear for me how to assign each field of the query to the relevant textbox, it's not clear at all how to assign the several values contained in one single field of the query to multiple textboxes.
As for example, this is my starting code:
Private Sub FillDates()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
ssql = "SELECT PricingDate From RoomCalendar WHERE PricingDate BETWEEN #01/01/2016# AND #31/01/2016# AND RateRoomCombinationId=17"
rst.Open ssql, cnn
Do Until rst.EOF = True
'txt1.Value = rst.Fields!PricingDate
'txt2.Value = rst.Fields!PricingDate
'txt3.Value = rst.Fields!PricingDate
rst.MoveNext
Loop
End Sub
Thank you in advance for your help
You can use:
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim Record As Integer
Dim Records As Integer
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
ssql = "SELECT PricingDate From RoomCalendar WHERE PricingDate BETWEEN #2016/01/01# AND #2016/01/31# AND RateRoomCombinationId=17"
rst.Open ssql, CNN
rst.MoveLast
rst.MoveFirst
Records = rst.RecordCount
For Record = 1 To Records
Me("txt" & CStr(Record)).Value = rst.Fields!PricingDate.Value
rst.MoveNext
Next
End Sub
Note please, the format for the date expressions.
I managed to solve the question on my own. Final code is:
Private Function FillDates()
Dim cnn As ADODB.Connection
Dim ssql As String
Dim rst As ADODB.Recordset
Set cnn = CurrentProject.Connection
Dim i As Integer
Dim Records As Integer
ssql = "SELECT PricingDate From RoomCalendar WHERE PricingDate BETWEEN #2016/01/01# AND #2016/01/31# AND RateRoomCombinationId=17"
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.Open ssql, cnn
Records = rst.RecordCount
For i = 1 To Records
Me("Text" & i).Value = rst.Fields!PricingDate.Value
rst.MoveNext
Next i
'' Clean up
rst.Close
Set rst = Nothing
End Function
Thanks for your help
How to fill up combobox during runtime using stored procedure to get values from database?
here's my code, this should be converted into stored procedure:
Private Sub ComboFill()
Set Rs = New ADODB.Recordset
Set Cmd = New ADODB.Command
With Cmd
.ActiveConnection = Conn
.CommandType = adCmdText
.CommandText = "SELECT suppliername from supplier"
Set Rs = .Execute
End With
If Not (Rs.BOF And Rs.EOF) Then
Rs.MoveFirst
End If
Do Until Rs.EOF
txtsupplier.AddItem Rs.Fields("suppliername").Value
Rs.MoveNext
Loop
End Sub
Try this (not tested):
EDIT: adjusted to return a RS, not a single value
Set Rs = New ADODB.Recordset
Set cn = New ADODB.Connection
cn.ConnectionString = Session.GetConnectionstring
cn.Open
Set cmd = New ADODB.Command
cmd.ActiveConnection = cn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = “MyStoredProcdure”
' Input param, if you need
' cmd.Parameters.Append cmd.CreateParameter(“Param1”, adInteger, adParamInput, , 614)
' Create a recordset by executing the command.
Set Rs = cmd.Execute()
Rs.MoveFirst()
Do Until Rs.EOF
txtsupplier.AddItem Rs.Fields("suppliername").Value
Rs.MoveNext
Set Rs = Nothing
Set cmd = Nothing
Set cn = Nothing
Access Database Form1 is a Continuous Form that has an EmployeeID field you can double click to take you to another form that contains information about the Employee. In order to retain the correct employee I use this code...
Private Sub EmployeeID_DblClick(cancel as integer)
Dim myID as variant
myID = me.EmployeeID
DoCmd.OpenForm "frm_EmployeeInfo",,,,,,myID
End Sub
This Not only brings up the correct employee information but populates the number into a hidden textbox to retain the information.
On the Employee Form there is a TabControl with 4 tabs, one of the tabs contains a Continous subform that I am trying to populate employee information but instead of the information being populated down (let's say Employee X has 8 lines of different attributes to display) it is repeating the same one. Here is my code for the subform:
Option Compare Database
Private Sub Form_open(cancel As Integer)
Dim strConnection, strSQL As String
Dim conn As ADODB.Connection
Dim tbl As ADODB.Recordset
Dim SourceCode As String
Dim myID As Variant
Set conn = New ADODB.Connection
strConnection = "ODBC;Driver={SQLserver};DSN=AccessDatabase;Server=Labor;DATABASE=Source;Trusted_Connection=Yes;"
conn.Open strConnection
myID = CInt(Me.OpenArgs)
SourceCode= Nz(DLookup("[SourceCode]", "Locaton", "[LOC_ID] = Forms!frmUtility![Site].value"), "")
If SourceCode<> "" Then
strSQL = "SELECT EmployeeID,BenefitID,DeductionAmount,BenefitAmount,CoverageAmount,EffectiveDate,"
strSQL = strSQL & "EligibleDate,ExpirationDate FROM "
strSQL = strSQL & SourceCode & "_EmployeesBenefitsNew WHERE EmployeeID= " & myID
Else
strSQL = "SELECT EmployeeID,BenefitID,DeductionAmount,BenefitAmount,CoverageAmount,EffectiveDate,"
strSQL = strSQL & "EligibleDate,ExpirationDate FROM "
strSQL = strSQL & "EmployeesBenefitsNew WHERE EmployeeID= " & myID
End If
Set tbl = New ADODB.Recordset
With tbl
Set .ActiveConnection = conn
.Source = strSQL
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.CursorLocation = adUseClient
.Open
End With
With tbl
On Error Resume Next
.MoveFirst
Do Until tbl.EOF
Me.txtBenefitID.Value = tbl!BenefitID
Me.txtDeductionAmt.Value = tbl!DeductionAmount
Me.txtBenefitAmt.Value = tbl!BenefitAmount
Me.txtCoverageAmt.Value = tbl!CoverageAmount
Me.txtEffDt.Value = tbl!EffectiveDate
Me.txtTermDt.Value = tbl!ExpirationDate
Set Me.Recordset = tbl
.MoveNext
Loop
.Close
End With
conn.Close
Set conn = Nothing
Set tbl = Nothing
End Sub
Can anyone shed some light on this situation? Thanks!
You need to either set the recordset or the recordsource with the data, you cannot write to a continuous form on different lines, the lines only display as different if you have a recordset.
So
''********************
Set Me.Recordset = tbl
''********************
In you code:
Private Sub Form_open(cancel As Integer)
Dim strConnection, strSQL As String
Dim conn As ADODB.Connection
Dim tbl As ADODB.Recordset
Dim SourceCode As String
Dim myID As Variant
Set conn = New ADODB.Connection
strConnection = "ODBC;Driver={SQLserver};DSN=AccessDatabase;Server=Labor;DATABASE=Source;Trusted_Connection=Yes;"
conn.Open strConnection
myID = CInt(Me.OpenArgs)
SourceCode= Nz(DLookup("[SourceCode]", "Locaton", "[LOC_ID] = Forms!frmUtility![Site].value"), "")
If SourceCode<> "" Then
strSQL = "SELECT EmployeeID,BenefitID,DeductionAmount,BenefitAmount,CoverageAmount,EffectiveDate,"
strSQL = strSQL & "EligibleDate,ExpirationDate FROM "
strSQL = strSQL & SourceCode & "_EmployeesBenefitsNew WHERE EmployeeID= " & myID
Else
strSQL = "SELECT EmployeeID,BenefitID,DeductionAmount,BenefitAmount,CoverageAmount,EffectiveDate,"
strSQL = strSQL & "EligibleDate,ExpirationDate FROM "
strSQL = strSQL & "EmployeesBenefitsNew WHERE EmployeeID= " & myID
End If
Set tbl = New ADODB.Recordset
With tbl
Set .ActiveConnection = conn
.Source = strSQL
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.CursorLocation = adUseClient
.Open
End With
''********************
Set Me.Recordset = tbl
''********************
conn.Close
Set conn = Nothing
Set tbl = Nothing
End Sub
The following code takes a parameter from a form and passes it to a stored procedure in vba. I am returning the values correctly and the stored procedure works when using debug.Print. Now I need to display the results of the stored procedure in the form "cat_percent_match". All this happens when the button is clicked. The code below does open the form, but now I need to pass the record set to it and display the results.
Any help is greatly appreciated.
Dim Cmd1 As ADODB.Command
Dim lngRecordsAffected As Long
Dim rs1 As ADODB.Recordset
Dim intRecordCount As Integer
'-----
Dim cnnTemp As ADODB.Connection
Set cnnTemp = New ADODB.Connection
cnnTemp.ConnectionString = "DRIVER=SQL Server;SERVER=***;" & _
"Trusted_Connection=No;UID=***;PWD=***;" & _
"Initial Catalog=IKB_QA;"
cnnTemp.ConnectionTimeout = 400
'Open Connection
cnnTemp.Open
Set Cmd1 = New ADODB.Command
Cmd1.ActiveConnection = cnnTemp
'---
With Cmd1
Dim localv As Integer
Dim inputv
localv = [Forms]![Start]![Selection]![cat_code]
.CommandText = "dbo.ix_spc_planogram_match_cat_percent " & inputv
.CommandType = adCmdStoredProc
Set inputv = Cmd1.CreateParameter("#deptcode", 3, 1, 10000, localv)
Cmd1.Parameters.Append inputv
Set rs1 = Nothing
Set rs1 = Cmd1.Execute
DoCmd.OpenForm "Cat_Percent_Match"
End With
End Sub
The relevant article is http://support.microsoft.com/kb/281998
Private Sub Form_Open(Cancel As Integer)
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
'Use the ADO connection that Access uses
Set cn = CurrentProject.AccessConnection
'Create an instance of the ADO Recordset class, and
'set its properties
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = cn
.Source = "SELECT * FROM Customers"
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
End With
'Set the form's Recordset property to the ADO recordset
Set Me.Recordset = rs
Set rs = Nothing
Set cn = Nothing
End Sub
So in this particular case, you can try:
DoCmd.OpenForm "Cat_Percent_Match"
Set Forms.Cat_Percent_Match.Recordset = rs1
Here's what I'm trying to do and I apologize if I'm headed the wrong direction. I'm trying to cycle through the filepath's stored in table t_Directory and if the file extension is "xlsx" open the Excel file and update another table called t_SheetInfo with the FileID of the Excel Worksheet and sheet count and the sheet name. Would anyone have a minute to check what I've got so far or steer me in the right direction if there's a more efficient way to do it? I'm not 100% sure that I know what I'm doing. As always, thank you in advance for any help!!
Dim db As DAO.Database
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
Private Sub CycleThroughWorkSheets()
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim sSQL1 As String
Dim sSQL2 As String
Dim sSQL3 As String
Dim rsFilePath As String
Dim rsWSName As String
Set db = CurrentDB
sSQL1 = "SELECT t_Directory.FileID, t_Directory.FilePath FROM t_Directory " & _
"WHERE (((t_Directory.FileExtension)=""'xlsx'""))"
Set rs = db.OpenRecordset("sSQL1", dbOpenDynaset)
With rs
rs.MoveFirst
Do While Not rs.EOF
rsFilePath = rs.Fields("[FilePath]")
OpenWorkBook (rsFilePath)
Set rs2 = db.OpenRecordset("t_SheetInfo", dbOpenDynaset)
With rs2
rs2.MoveFirst
Do While Not rs2.EOF
rs2.AddNew
rs2.Fields("FileID") = rs.Fields(1)
rs2.Fields("[SheetIndex]") = WorkSheetCount(rsFilePath)
rs2.Fields("[SheetName]") = WorkSheetName(WorkSheetCount)
rs2.Update
Next
Loop
End With
End With
Set rs = Nothing
Set rs2 = Nothing
End Sub
Public Function WorkSheetCount(rsFilePath As String) As Integer
Set xlWB = xlApp.Workbooks.Open(rsFilePath)
WorkSheetCount = xlWB.Sheets.Count(rsFilePath)
Debug.Print "WorkSheetCount : " & WorkSheetCount
End Function
Public Function WorkSheetName(WorkSheetCount As Integer) As String
Set xlWB = xlApp.Workbooks.Open(rsFilePath)
WorkSheetName = Worksheets(WorkSheetCount).Name
Debug.Print "WorkSheetName : " & WorkSheetName
End Function
Try something on these lines. Step through.
Dim xlApp As New Excel.Application
Dim xlWB As Excel.Workbook
Dim sh As Object ''Some sheets may be charts
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim sSQL1 As String
Dim sSQL2 As String
Dim sSQL3 As String
Dim rsFilePath As String
Dim rsWSName As String
Set db = CurrentDb
xlApp.Visible = True
sSQL1 = "SELECT t_Directory.FileID, t_Directory.FilePath FROM t_Directory " & _
"WHERE t_Directory.FileExtension='.xlsx'"
Set rs2 = db.OpenRecordset("t_SheetInfo", dbOpenDynaset)
Set rs = db.OpenRecordset(sSQL1, dbOpenDynaset)
Do While Not rs.EOF
rsFilePath = rs.Fields("[FilePath]")
Set xlWB = xlApp.Workbooks.Open(rsFilePath)
For Each sh In xlWB.Sheets
rs2.AddNew
rs2.Fields("FileID") = rs.Fields("FileID")
rs2.Fields("[SheetIndex]") = sh.Index
rs2.Fields("[SheetName]") = sh.Name
rs2.Update
Next
rs.MoveNext
xlWB.Close False
Loop
Set rs = Nothing
Set rs2 = Nothing
xlApp.Quit