我在编辑我的VBA模块中当前存在的记录集时出现运行时错误。

huangapple
go评论144阅读模式
英文:

I get runtime error when editing a currently existing recordset in my vba module

问题

I am not that good in adodb.recordsets, however I have been using macros for many years. anyway, I have a vba code in which I use 3 recordsets to get the information from 3 different excel sheets. In the 4th recordset I gather the information of other recordsets and put them in different items using a field as a key.
When I use rst.movefirst and then 'do...loop while' for the first time in the code, everything is perfect.
Then, when I try to edit the values of the same recordset using another 'do...loop while' loop, I get runtime error '-214352571(80020005)'. I am not sure where the problem is:


i = 3
Sheets("Data Bank").Calculate

rw = Sheets("pipur").Cells(Rows.Count, 11).End(xlUp).Row
rw2 = Sheets("CurAlloc").Cells(Rows.Count, 1).End(xlUp).Row
rw3 = Sheets("ImpRec").Cells(Rows.Count, 1).End(xlUp).Row

If rw = 1 Then
MsgBoxW Sheets("Data Bank").Range("H15").Value
Exit Sub
End If

If rw2 = 1 Then
MsgBoxW Sheets("Data Bank").Range("H35").Value
Exit Sub
End If

With ImportCurrencyReceipt

    ' for purchase registration information
    .hamk.Clear
    .sabNum.Clear
    .sabAmnt.Clear
    .SabCur.Clear
    .GhrAmnt.Clear
    .GhrCur.Clear

    ' for currency allocation information
    .Taham.Clear
    .Taval.Clear
    .Tacod.Clear

    ' for purchase information
    .Taham2.Clear
    .Taval2.Clear
    .Tacod2.Clear

    'for currency allocation and purchase control
    .kolCod.Clear
    .kolTakh.Clear
    .kolKhar.Clear
    .Tacod.Clear

    ' for purchase information
    .Taham2.Clear
    .Taval2.Clear
    .Tacod2.Clear

    'for currency allocation and purchase control
    .kolCod.Clear
    .kolTakh.Clear
    .kolKhar.Clear
End With End With

Dim ss As ADODB.Recordset
Set ss = New ADODB.Recordset

With ss.Fields
.Append "hamNum", adVariant
.Append "SabtSefaresh", adVariant
.Append "SabtAmnt", adDouble, 120
.Append "SabtCur", adVariant
.Append "GharAmnt", adDouble, 120
.Append "GharCur", adVariant
.Append "Show", adBoolean
End With
ss.Open

' fill ss recordset with the purchase information
For i = 2 To rw
ss.AddNew
ss!hamNum = Sheets("pipur").Cells(i, 12).Value
ss!SabtSefaresh = Sheets("pipur").Cells(i, 13).Value
ss!SabtAmnt = Sheets("pipur").Cells(i, 14).Value
ss!SabtCur = Sheets("pipur").Cells(i, 16).Value
ss!Gharamnt = Sheets("pipur").Cells(i, 15).Value
ss!GharCur = Sheets("pipur").Cells(i, 17).Value
ss!Show = True
Next i

Dim tak As New ADODB.Recordset
 tak.Fields.Append "Sham", adVariant
 tak.Fields.Append "Tval", adDouble
 tak.Fields.Append "Tcod", adVariant
 tak.Open
 
' fill tak recordset with currency allocation information
With Sheets("CurAlloc")
    For j = 2 To rw2
        tak.AddNew
        tak!Sham = .Cells(j, 1).Value
        tak!Tval = .Cells(j, 10).Value
        tak!tcod = .Cells(j, 11).Value
    Next j
End With

Dim khar As New ADODB.Recordset
 khar.Fields.Append "Tham", adVariant
 khar.Fields.Append "Tval2", adDouble
 khar.Fields.Append "Tcod2", adVariant
 khar.Open

' fill khar recordset with currecny purchase information
With Sheets("ImpRec")
    For k = 2 To rw3
        khar.AddNew
        khar!Tham = .Cells(k, 2).Value
        khar!Tval2 = .Cells(k, 8).Value
        khar!Tcod2 = .Cells(k, 12).Value
    Next k
End With

Dim kol As New ADODB.Recordset
 kol.Fields.Append "klham", adVariant
 kol.Fields.Append "klC", adVariant
 kol.Fields.Append "klT", adDouble
 kol.Fields.Append "klK", adVariant
 kol.Open
 
' initial filling of kol recordset
tak.MoveFirst
    Do
        kol.AddNew
        kol!klham = tak!Sham
        kol!klC = tak!tcod
        kol!klT = 0
        kol!klK = 0
        tak.MoveNext
    Loop While Not tak.EOF

' put currecny allocation and currency purchase information in KlT and klK fields of kol recordset
tak.MoveFirst
    Do
        khar.MoveFirst
        Do
            kol.MoveFirst
            Do
                If StrComp(kol!klham, tak!Sham) = 0 And StrComp(kol!klC, tak!tcod) = 0 Then
                    kol!klT = kol!klT + tak!Tval
                End If
                
                If StrComp(kol!klham, khar!Tham) = 0 And StrComp(kol!klC, khar!Tcod2) = 0 Then
                    kol!klK = kol!klK + khar!Tval2
                End If
                
                kol.MoveNext
            Loop While Not kol.EOF
            
        khar.MoveNext
        Loop While Not khar.EOF
        
    tak.MoveNext
    Loop While Not tak.EOF
    
    ' here we delete all purchases with no currency allocation code
    ss.MoveLast
    Dim found As Boolean: found = False
        Do While Not ss.BOF
            tak.MoveFirst
            Do
                If StrComp(tak!Sham, ss!hamNum) = 0 Then found = True
                tak.MoveNext
            Loop While Not tak.EOF
            If found = False Then ss.Delete
            ss.MovePrevious
        Loop

' here I transfer the information from recordsets to the comboboxes in userform and then close the recordsets

With ImportCurrencyReceipt

    ss.MoveLast: ss.MoveFirst
    Do While Not ss.EOF
        .hamk.AddItem ss!hamNum
        .sabNum.AddItem ss!SabtSefaresh
        .sabAmnt.AddItem ss!SabtAmnt
        .SabCur.AddItem ss!SabtCur
        .GhrAmnt.AddItem ss!Gh

<details>
<summary>英文:</summary>

I am not that good in adodb.recordsets, however I have been using macros for many years. anyway, I have a vba code in which I use 3 recordsets to get the information from 3 different excel sheets. In the 4th recordset I gather the information of other recordsets and put them in different items using a field as a key.
When I use rst.movefirst and then &#39;do...loop while&#39; for the first time in the code, everything is perfect.
Then, when I try to edit the values of the same recordset using another &#39;do...loop while&#39; loop, I get runtime error &#39;-214352571(80020005)&#39;. I am not sure where the problem is:

Sub imp_currency_receipt()

i = 3
Sheets("Data Bank").Calculate

rw = Sheets("pipur").Cells(Rows.Count, 11).End(xlUp).Row
rw2 = Sheets("CurAlloc").Cells(Rows.Count, 1).End(xlUp).Row
rw3 = Sheets("ImpRec").Cells(Rows.Count, 1).End(xlUp).Row

If rw = 1 Then
MsgBoxW Sheets("Data Bank").Range("H15").Value
Exit Sub
End If

If rw2 = 1 Then
MsgBoxW Sheets("Data Bank").Range("H35").Value
Exit Sub
End If

With ImportCurrencyReceipt

&#39; for purchase registration information
.hamk.Clear
.sabNum.Clear
.sabAmnt.Clear
.SabCur.Clear
.GhrAmnt.Clear
.GhrCur.Clear

&#39; for currency allocation information
.Taham.Clear
.Taval.Clear
.Tacod.Clear

&#39; for purchase information
.Taham2.Clear
.Taval2.Clear
.Tacod2.Clear

&#39;for currency allocation and purchase control
.kolCod.Clear
.kolTakh.Clear
.kolKhar.Clear
.Tacod.Clear

&#39; for purchase information
.Taham2.Clear
.Taval2.Clear
.Tacod2.Clear

&#39;for currency allocation and purchase control
.kolCod.Clear
.kolTakh.Clear
.kolKhar.Clear

End With
End With

Dim ss As ADODB.Recordset
Set ss = New ADODB.Recordset

With ss.Fields
.Append "hamNum", adVariant
.Append "SabtSefaresh", adVariant
.Append "SabtAmnt", adDouble, 120
.Append "SabtCur", adVariant
.Append "GharAmnt", adDouble, 120
.Append "GharCur", adVariant
.Append "Show", adBoolean
End With
ss.Open

' fill ss recordset with the purchase information
For i = 2 To rw
ss.AddNew
ss!hamNum = Sheets("pipur").Cells(i, 12).Value
ss!SabtSefaresh = Sheets("pipur").Cells(i, 13).Value
ss!SabtAmnt = Sheets("pipur").Cells(i, 14).Value
ss!SabtCur = Sheets("pipur").Cells(i, 16).Value
ss!Gharamnt = Sheets("pipur").Cells(i, 15).Value
ss!GharCur = Sheets("pipur").Cells(i, 17).Value
ss!Show = True
Next i

Dim tak As New ADODB.Recordset
tak.Fields.Append "Sham", adVariant
tak.Fields.Append "Tval", adDouble
tak.Fields.Append "Tcod", adVariant
tak.Open

' fill tak recordset with currency allocation information
With Sheets("CurAlloc")
For j = 2 To rw2
tak.AddNew
tak!Sham = .Cells(j, 1).Value
tak!Tval = .Cells(j, 10).Value
tak!tcod = .Cells(j, 11).Value
Next j
End With

Dim khar As New ADODB.Recordset
khar.Fields.Append "Tham", adVariant
khar.Fields.Append "Tval2", adDouble
khar.Fields.Append "Tcod2", adVariant
khar.Open

' fill khar recordset with currecny purchase information
With Sheets("ImpRec")
For k = 2 To rw3
khar.AddNew
khar!Tham = .Cells(k, 2).Value
khar!Tval2 = .Cells(k, 8).Value
khar!Tcod2 = .Cells(k, 12).Value
Next k
End With

Dim kol As New ADODB.Recordset
kol.Fields.Append "klham", adVariant
kol.Fields.Append "klC", adVariant
kol.Fields.Append "klT", adDouble
kol.Fields.Append "klK", adVariant
kol.Open

' initial filling of kol recordset
tak.MoveFirst
Do
kol.AddNew
kol!klham = tak!Sham
kol!klC = tak!tcod
kol!klT = 0
kol!klK = 0
tak.MoveNext
Loop While Not tak.EOF

' put currecny allocation and currency purchase information in KlT and klK fields of kol recordset
tak.MoveFirst
Do
khar.MoveFirst
Do
kol.MoveFirst
Do
If StrComp(kol!klham, tak!Sham) = 0 And StrComp(kol!klC, tak!tcod) = 0 Then
kol!klT = kol!klT + tak!Tval
End If

            If StrComp(kol!klham, khar!Tham) = 0 And StrComp(kol!klC, khar!Tcod2) = 0 Then
                kol!klK = kol!klK + khar!Tval2
            End If
            
            kol.MoveNext
        Loop While Not kol.EOF
        
    khar.MoveNext
    Loop While Not khar.EOF
    
tak.MoveNext
Loop While Not tak.EOF


&#39; here we delete all purchases with no currency allocation code
ss.MoveLast
Dim found As Boolean: found = False
    Do While Not ss.BOF
        tak.MoveFirst
        Do
            If StrComp(tak!Sham, ss!hamNum) = 0 Then found = True
            tak.MoveNext
        Loop While Not tak.EOF
        If found = False Then ss.Delete
        ss.MovePrevious
    Loop

' here I transfer the information from recordsets to the comboboxes in userform and then close the recordsets

With ImportCurrencyReceipt

ss.MoveLast: ss.MoveFirst
Do While Not ss.EOF
    .hamk.AddItem ss!hamNum
    .sabNum.AddItem ss!SabtSefaresh
    .sabAmnt.AddItem ss!SabtAmnt
    .SabCur.AddItem ss!SabtCur
    .GhrAmnt.AddItem ss!Gharamnt
    .GhrCur.AddItem ss!GharCur
    ss.MoveNext
Loop
If ss.State = 1 Then
    ss.Close
    Set ss = Nothing
End If

tak.MoveLast: tak.MoveFirst
Do While Not tak.EOF
    .Taham.AddItem tak!Sham
    .Taval.AddItem tak!Tval
    .Tacod.AddItem tak!tcod
    tak.MoveNext
Loop
If tak.State = 1 Then
    tak.Close
    Set tak = Nothing
End If

khar.MoveLast: khar.MoveFirst
Do While Not khar.EOF
    .Taham2.AddItem khar!Tham
    .Taval2.AddItem khar!Tval2
    .Tacod2.AddItem khar!Tcod2
    khar.MoveNext
Loop
If khar.State = 1 Then
    khar.Close
    Set khar = Nothing
End If

kol.MoveLast: kol.MoveFirst
Do While Not kol.EOF
    .kolCod.AddItem kol!klC
    .kolTakh.AddItem kol!klT
    .kolKhar.AddItem kol!klK
    kol.MoveNext
Loop
If kol.State = 1 Then
    kol.Close
    Set kol = Nothing
End If

End With




i get the error in line &#39;.kolCod.AddItem kol!klC&#39;. kol!KlT and kol!klK has value and are ok.Is there any limitation in the number of times that you can edit on or make change in a recordset?

![enter image description here](https://i.stack.imgur.com/yc2eD.png)

I tried different ways of definition of the recordsets. I changed the code to the simplest form. But still something is missing or I don&#39;t know or cannot understand.

</details>


# 答案1
**得分**: 1

运行时错误 runtime error '-214352571(80020005)' 通常表示类型不匹配，这意味着您可能在字符串和数字之间存在问题，或者可能是空值的问题。

这一行导致错误：

.kolCod.AddItem kol!klC


...我认为这一行是从记录集中提取一个值，并将其添加到组合框作为一个项目？

kol!klC 的值是多少？也许它是空的？如果是这样，您可以尝试这样做：

.kolCod.AddItem Nz(kol!klC,"(空)")


<details>
<summary>英文:</summary>

Runtime error runtime error &#39;-214352571(80020005)&#39; usually means Type Mismatch which means you&#39;ve got some sort of problem with strings vs numbers or maybe a null value problem.

This line is giving the error:

    .kolCod.AddItem kol!klC

... and I think this line is pulling a value from a recordset and adding it to a combobox as an item?

What is the value of kol!klC? Maybe it is null? In which case you could try this:

    .kolCod.AddItem Nz(kol!klC,&quot;(empty)&quot;)


</details>

huangapple
  • 本文由 发表于 2023年3月15日 18:45:29
  • 转载请务必保留本文链接：https://go.coder-hub.com/75743627.html
  • excel
  • recordset
  • vba
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定