0
ストアドプロシージャの知識が非常に基本的であると言って始めましょう。私はVBAで基本的なクエリと戻り値を書き込む方法を知っています。私は、基本的に私の知識が壊れているSQL内のプログラムを書くことができることも知っています。私はそれだけで十分ではありません。とにかく、VBAでは、私は一連のクエリを実行します。このプロジェクトの構想段階で恐れていたように、単一のルーチンから多すぎるクエリを実行するために、実際のパフォーマンス上の問題が発生します。ここにルーチンがあります。VBAで複数のクエリを使用するストアドプロシージャ
Public Sub linePoll()
errorPosition = "aofResults.linePoll"
On Error GoTo errorTrap
Err.Clear
Dim rst As ADODB.Recordset
Dim rstA As ADODB.Recordset
Dim rstB As ADODB.Recordset
Dim rstC As ADODB.Recordset
Dim rstD As ADODB.Recordset
Dim rstE As ADODB.Recordset
Dim packQty As Integer
Dim m As Integer
Dim formFactor As Integer
m = 0
constr = "Provider=sqloledb;data source=i.p.add.ress;initial catalog=catalog;user id=user;password=password"
Set conn = New ADODB.connection
Set cmd = New ADODB.Command
conn.Open constr
cmd.ActiveConnection = conn
LogDiagnosticsMessage "Getting order quantity"
cmd.CommandText = "SELECT ISNULL(SUM(lQ.[QUANTITY]), 0) FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_LINE_QUEUE] AS lQ LEFT JOIN [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_QUEUE] AS oQ ON lQ.[SALES_ORDER_NUMBER] = oQ.[SALES_ORDER_NUMBER]"
Set rst = cmd.execute 'Get total order quantity, may change if inventory depletes.
If Not rst.EOF = True Then
LogDiagnosticsMessage "Found order quantity as " & rst(0)
Set eTag = ThisDisplay.eGroup.item("AOF\soQuantity")
eTag.value = rst(0)
Else
LogDiagnosticsMessage "No order found in line queue DB"
End If
If Not rst(0) = 0 Then
LogDiagnosticsMessage "Getting optic order quantity packed"
cmd.CommandText = "SELECT Count(rL.SERIAL_NUMBER) FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_OPTIC_RESULTS] AS rL WHERE EXISTS (SELECT [SO_LINE_NUMBER] FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_LINE_QUEUE] AS lQ LEFT JOIN [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_QUEUE] AS oQ ON lQ.[SALES_ORDER_NUMBER] = oQ.SALES_ORDER_NUMBER) AND [REJECT] = 'False'"
Set rst = cmd.execute
If Not rst.EOF = True Then
LogDiagnosticsMessage "Found optics order quantity packed as " & rst(0)
Set eTag = ThisDisplay.eGroup.item("AOF\soQuantityPacked")
eTag.value = rst(0)
Else
LogDiagnosticsMessage "No packed optics found in results DB"
End If
Set eTag = ThisDisplay.eGroup.item("Machine\itoSettings0") 'Evaluate packing quantity against machine settings (stored in DB, written to PLC at first startup)
LogDiagnosticsMessage "Evaluating manual pack need"
If rst(0) < eTag.value Then
Set eTag = ThisDisplay.eGroup.item("AOF\manualPack") 'Evaluate packing quantity
eTag.value = True
Else
eTag.value = False
End If
LogDiagnosticsMessage "Getting the top line order information"
cmd.CommandText = "SELECT lQ.[SO_LINE_NUMBER],lQ.[QUANTITY],lQ.[SELECTED],lQ.[FORM_FACTOR_ID], lQ.[FINISHED_PART_NUMBER], ISNULL(lQ.[OEM_PART_NUMBER], ''),ISNULL(lQ.[COMPATIBILITY], ''), oQ.[INDIVIDUAL_PACKAGING], oQ.[SALES_ORDER_NUMBER] FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_QUEUE] AS oQ LEFT JOIN [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_LINE_QUEUE] AS lQ ON oQ.[SALES_ORDER_NUMBER] = lQ.[SALES_ORDER_NUMBER] WHERE lQ.[SO_LINE_NUMBER] IS NOT NULL ORDER BY lQ.[SELECTED] DESC,lQ.[COMPLETED] ASC"
Set rstA = cmd.execute() 'Returns the line orders associated to the sales order
If Not rstA.EOF = True Then
Set eTag = ThisDisplay.eGroup.item("AOF\SOLineNumber")
If Not eTag.value = rstA(0) Then '************************************Updates the line order if the line order is different than what's already selected
Set eTag = ThisDisplay.eGroup.item("AOF\SOLineNumber")
eTag.value = rstA(0)
Set eTag = ThisDisplay.eGroup.item("AOF\QuantityOrdered")
eTag.value = rstA(1)
Set eTag = ThisDisplay.eGroup.item("AOF\FinishedPartNumber")
eTag.value = rstA(4)
Set eTag = ThisDisplay.eGroup.item("AOF\OEMPartNumber")
eTag.value = rstA(5)
Set eTag = ThisDisplay.eGroup.item("AOF\Compatibility")
eTag.value = rstA(6)
Set eTag = ThisDisplay.eGroup.item("AOF\IndividualPack") 'PLC expects "Double Pack" true\false, ITO sends "Single Pack" true\false
eTag.value = Not rstA(7)
End If '************************************
LogDiagnosticsMessage "Getting the quantity of parts passed for this line order"
cmd.CommandText = "SELECT COUNT(oL.[SERIAL_NUMBER]) FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_OPTICS] AS oL WHERE NOT EXISTS (SELECT [SERIAL_NUMBER] FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_OPTIC_RESULTS] rL WHERE oL.[SERIAL_NUMBER] = rL.[SERIAL_NUMBER]) AND oL.[SO_LINE_NUMBER] = " & rstA(0)
Set rstB = cmd.execute() 'Returns the count of the parts associated to the above line order that passed
If Not rstB.EOF = True Then
Set eTag = ThisDisplay.eGroup.item("AOF\QuantityPassed")
eTag.value = rstB(0)
LogDiagnosticsMessage "Evaluating parts remaining for this line order as " & rstB(0)
Select Case rstB(0) 'Evaluate Qty left to process in active line order
Case Is = 0 'Qty Zero (Line order complete)
LogDiagnosticsMessage "Setting line order as completed"
cmd.CommandText = "UPDATE [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_LINE_QUEUE] SET [SELECTED] = 'False', [COMPLETED] = 'True' WHERE [SO_LINE_NUMBER] = " & rstA(0)
cmd.execute 'Unselect the currently index line order and Set order as completed
LogDiagnosticsMessage "Checking line order quantity against sales order quantity"
cmd.CommandText = "SELECT ((SELECT COUNT(lQ.[SO_LINE_NUMBER]) FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_LINE_QUEUE] AS lQ LEFT JOIN [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_QUEUE] AS oQ ON oQ.[SALES_ORDER_NUMBER] = lQ.[SALES_ORDER_NUMBER]) - (SELECT COUNT(lQ.[SO_LINE_NUMBER]) FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_LINE_QUEUE] AS lQ LEFT JOIN [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_QUEUE] AS oQ ON oQ.[SALES_ORDER_NUMBER] = lQ.[SALES_ORDER_NUMBER] WHERE lQ.[COMPLETED] = 'True'))"
Set rstD = cmd.execute() 'Check line queue quantity associated to the sales order, count the line orders associated to the current sales order in the queue that are incomplete
'Set the currently indexed line order as selected
If rstD(0) = 0 Then
cmd.CommandText = "SELECT [ID] FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_BOXES] WHERE [SELECTED] = 'True'"
Set rstE = cmd.execute()
If Not rstE.EOF = False Then
Set eTag = ThisDisplay.eGroup.item("AOF\soFinished")
eTag.value = True
Set eTag = ThisDisplay.eGroup.item("AOF\PLC_FinishBox")
If eTag.value = 1 Then
LogDiagnosticsMessage "Checking whether or not the PLC ready to complete the order"
Set eTag = ThisDisplay.eGroup.item("AOF\PLC_CompleteOrder") 'Checks that order fulfillment mode is turned off
If eTag.value = 1 Then
boxNum = 0
LogDiagnosticsMessage "Unselecting sales order " & rstA(8) & ", deleting results for this sales order, and setting status to ERP"
cmd.CommandText = "UPDATE [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_QUEUE] SET [SELECTED] = 'False' WHERE [SALES_ORDER_NUMBER] = '" & rstA(8) & "'"
cmd.execute 'Set's the current sales order selected bit to off
cmd.CommandText = "UPDATE [ROBOTICS_OPTICS_MECHUAT].[dbo].[MACHINE_STATE] SET [STATUS] = 'USER' where [OPERATING_STATE] = 2"
cmd.execute 'sets the status back to USER
cmd.CommandText = "DELETE FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_OPTIC_RESULTS]"
cmd.execute
Set eTag = ThisDisplay.eGroup.item("AOF\orderFulfillmentMode")
eTag.value = 0
Set eTag = ThisDisplay.eGroup.item("AOF\PLC_CompleteOrder")
eTag.value = 0
End If
End If
End If
rstE.Close
Else
rstA.MoveNext 'Index to the next line order in the record set
LogDiagnosticsMessage "Indexing to the next order in the list, setting" & rstA(0) & " selected."
cmd.CommandText = "UPDATE [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_LINE_QUEUE] SET [SELECTED] = 'True' WHERE [SO_LINE_NUMBER] = " & rstA(0)
cmd.execute
rstD.Close
End If
Case Is > 0 'Qty Remaining > Line Order Qty (Line Order Select)
LogDiagnosticsMessage "Getting the form factor for this line order"
cmd.CommandText = "SELECT fF.[FORM_FACTOR_DESCRIPTION] FROM [ROBOTICS_OPTICS_MECHUAT].[dbo].[FORM_FACTOR] AS fF LEFT JOIN [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_LINE_QUEUE] AS lQ ON lQ.[FORM_FACTOR_ID] = fF.[FORM_FACTOR_ID] WHERE lQ.[SELECTED] = 'True'"
Set rstC = cmd.execute() 'Returns the form factor description that is currently selected in the order line queue
If Not rstC.EOF = True Then
Set eTag = ThisDisplay.eGroup.item("AOF\FormFactor")
eTag.value = rstC(0)
Set eTag = ThisDisplay.eGroup.item("AOF\NextOpticXFP")
Select Case rstC(0)
Case Is = "XFP"
eTag.value = True
Case Is <> "XFP"
eTag.value = Not True
End Select
End If
rstC.Close
LogDiagnosticsMessage "Setting " & rstA(0) & " as selected"
cmd.CommandText = "UPDATE [ROBOTICS_OPTICS_MECHUAT].[dbo].[AOF_ORDER_LINE_QUEUE] SET [SELECTED] = 'True' WHERE [SO_LINE_NUMBER] = " & rstA(0)
cmd.execute 'Set line as selected
Case Else
End Select
Else
MsgBox ("Error: No line orders exist for sales order " & rstA(4) & ".")
End If
ElseIf rstA.EOF = True Then
MsgBox ("Error: No sales order exists or no line orders associated to sales order: " & rstA(4) & " exists.")
End If
End If
Set eTag = ThisDisplay.eGroup.item("AOF\ITO_OpticsReady")
eTag.value = True
GoTo cleanExit
cleanExit:
On Error Resume Next
If Not rst Is Nothing Then
rst.Close
End If
If Not rstA Is Nothing Then
rstA.Close
End If
If Not rstB Is Nothing Then
rstB.Close
End If
If Not rstC Is Nothing Then
rstC.Close
End If
If Not rstD Is Nothing Then
rstD.Close
End If
If Not rstE Is Nothing Then
rstE.Close
End If
conn.Close
Exit Sub
errorTrap:
LogDiagnosticsMessage "_Eventwatcher2.gfx, Position: " & errorPosition & " , Error Code: [ " & Hex(Err.number) & "], Description: " & Err.Description & ""
Resume cleanExit
End Sub
ここで私の考えは、サーバー側にもっと処理を加えることです。これらのクエリのほとんどをカプセル化するために個別のストアドプロシージャを作成しましたが、パフォーマンスには十分強い影響はありませんでした。ここに私を連れて来る私の主な考えは、これをすべて単一のストアドプロシージャに入れることができますか？ストアドプロシージャから7つのクエリを実行すると、VBAコードでどのように処理できますか？ 1つのクエリは次のクエリとどのように区別されますか？ストアドプロシージャ内の別のクエリの入力としてクエリの出力を使用するにはどうすればよいですか？
ありがとうございます！
編集：私はselect文を使用するクエリを統合しています。私は次のようになりました。これはうまくいくようです。
Private Sub Button1_Released()
Dim rst(1 To 8) As ADODB.Recordset
errorPosition = "ThisDisplay.Button1 Test"
On Error GoTo errorTrap
Err.Clear
Set conn = New ADODB.Connection
Set cmd = New ADODB.Command
constr = "Provider=sqloledb;data source=i.p.add.ress;initial catalog=CATALOG;user id=user;password=pass"
conn.Open constr
With cmd
.ActiveConnection = conn
.CommandText = "rt_test"
.CommandType = adCmdStoredProc
.CommandTimeout = 2
End With
Set rst(1) = cmd.Execute()
For i = 2 To 8
Set rst(i) = rst(i - 1).NextRecordset
Next
i = 1
GoTo cleanExit
cleanExit:
On Error Resume Next
For i = 1 To 8
If Not rst(i) Is Nothing Then
rst(i).Close
End If
Next
conn.Close
Exit Sub
errorTrap:
LogDiagnosticsMessage "_Eventwatcher2.gfx, Position: " & errorPosition & " , Error Code: [ " & Hex(Err.Number) & "], Description: " & Err.Description & ""
Resume cleanExit
End Sub
最終更新日：
上記に小さな変化が、私は必要な結果が得られました。その結果、ADOはNextRecordSetメソッドが呼び出されると自動的に前のレコードセットを閉じます。その代わりに、レコードセットを開いて配列にクローンし、次のレコードセットに移動する必要がありました。 プレースホルダとして機能する別のレコードセットを追加しました。あなたが思う、私は怖いよりも少し複雑です
conn.CursorLocation = adUseClient 'Needed to index through and clone recordsets
conn.Open constr
With cmd 'Run stored procedure
.ActiveConnection = conn
.CommandText = "rt_test"
.CommandType = adCmdStoredProc
.CommandTimeout = 2
End With
Set recordSet = cmd.execute()
For i = 1 To 8
Set rst(i) = recordSet.Clone
Set recordSet = recordSet.NextRecordset
Next
...
...
...
cleanExit:
On Error Resume Next
If Not recordSet Is Nothing Then
recordSet.Close
End If
For i = 1 To 8
If Not rst(i) Is Nothing Then
rst(i).Close
End If
Next
conn.Close
Exit Sub
errorTrap:
LogDiagnosticsMessage "_Eventwatcher2.gfx, Position: " & errorPosition & " , Error Code: [ " & Hex(Err.number) & "], Description: " & Err.Description & ""
Resume cleanExit
End Sub
おそらく、より良いアプローチは、必要な最終的な結果セットを得ることです。それが失敗した場合にのみ、より多くのクエリで理由を検出しようとします。 – Serg