VBA函数返回集合类型

时间:2015-06-29 14:20:21

标签: vba function collections return-type

我有一个函数可以根据传递给它的两个参数对记录集进行一些操作。

完成工作后,我试图让函数返回一个包含函数工作ID的集合。代码有效,但当它尝试End Function时,我得到错误450

  

参数数量错误或属性分配无效

我已经看了几个小时了,我无法弄清楚导致错误的原因。它绝对不是语法错误或拼写错误,因为整个代码在结束前没有错误地执行。我使用Set将集合分配回函数。 (即Set functionA = someCollection

Public Function ConsumedMaterial(prodName As String, totalQty As Integer) As Collection
On Error GoTo ConsumedMaterial_Err
Dim rst As Recordset
Dim db As Database
Dim strSQL As String

Set ConsumedMaterial = New Collection
Set db = CurrentDb()
strSQL = "SELECT * FROM [Production Data] " & _
         "WHERE Product = '" & prodName & "' " & _
         "AND Status > '3' " & _
         "ORDER BY ID;"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)

Dim oBal, curBal, amtRem, totLots
totLots = DCount("[Lot Number]", "Production Data", "[Product] = '" & prodName & "' " & "AND [Status] > '3'")
oBal = DSum("[Amount Remaining]", "Production Data", "[Product] = '" & prodName & "' " & "AND [Status] > '3'")
curBal = totalQty

If totalQty > oBal Then
    MsgBox "Not enough material for this order. Please create a new Production Order.", vbCritical
    GoTo ConsumedMaterial_Exit
End If


 Dim lotsCol As Collection
 Set lotsCol = New Collection
 With rst
    Do While Not rst.EOF
        amtRem = .Fields("Amount Remaining").Value
             If curBal = 0 Then
                Exit Do
             ElseIf (amtRem - curBal) < 0 Then
                 .Edit
                  curBal = Abs(amtRem - curBal)
                 .Fields("Amount Remaining").Value = amtRem - (totalQty - curBal)
                  lotsCol.Add (rst.Fields("Lot Number").Value)
                  totalQty = totalQty - amtRem
                  .Update
                 .MoveNext
             Else
                  .Edit
                  amtRem = amtRem - curBal
                 .Fields("Amount Remaining").Value = amtRem
                  lotsCol.Add (rst.Fields("Lot Number").Value)
                  curBal = 0
                  .Update
                 .MoveNext
             End If
    Loop
End With

Set ConsumedMaterial = lotsCol


'Dim i
'For Each i In lotsCol
'    Debug.Print i
'Next

rst.Close
db.Close
Set rst = Nothing
Set db = Nothing
Set lotsCol = Nothing

ConsumedMaterial_Exit:
Exit Function

ConsumedMaterial_Err:
MsgBox Error$ & vbCrLf & vbCrLf & "Unable to create an order at this time."
Resume ConsumedMaterial_Exit



End Function

1 个答案:

答案 0 :(得分:0)

我不确切知道发生了什么,因为我没有更改任何代码,但现在可以正常工作并且不再出现错误。感谢您的帮助。