Question

我正在粗略地编写我想开发的桌面软件的概念证明。我正在使用Access 2013。

以下代码用于分析一个表中的记录（＆＃39; tblRestructures＆＃39;），然后根据分析，它应该在另一个表中填充记录（＆＃39; tblInScopeRestructures＆＃39;）。设置tblRestructures中的样本数据，使得代码应该导致具有字段（Gen）的记录，其值为1到6（包括1和6）。有时代码确实按预期成功填充tblInScopeRestructures，但有时代码会提前结束（即满足结束各种循环的条件）。尽管花了很多时间来确定变化的原因并在这里寻找类似的问题，但我仍然没有更聪明。

感谢任何帮助。我为我丑陋的代码道歉 - 我没有经验，在这个阶段我只是试图加快概念验证。

以下是代码：

Public Function NbrOfShares3(strCode As String, dteDate As Date) As Single
Dim i As Integer
Dim strPrevCode1 As String
Dim adConn As ADODB.Connection
Set adConn = New ADODB.Connection
adConn.Open CurrentProject.Connection
Dim adrsa As ADODB.Recordset
Set adrsa = New ADODB.Recordset
adConn.Execute "DELETE * from tblInScopeRestructures"
adrsa.ActiveConnection = CurrentProject.Connection
adrsa.CursorType = adOpenStatic
' Identify all gen 1 (Code1 = CODE) restructures up to dteDate and put in a temp table
adrsa.Open "SELECT tblRestructure.Code1, tblRestructure.Code2, tblRestructure.RecDate " & _
"FROM tblRestructure " & _
"WHERE (((tblRestructure.Code1)='" & strCode & "'))  AND (((tblRestructure.RecDate)<=#" & Format(dteDate, "mm/dd/yyyy") & "#));"
If adrsa.RecordCount <> 0 Then
    adrsa.MoveFirst
    Do While Not adrsa.EOF
       adConn.Execute ("INSERT INTO tblInScopeRestructures(Code1,Code2,RecDate,Gen) VALUES ('" & adrsa.Fields("Code1") & "','" & adrsa.Fields("Code2") & _
       "',#" & Format(adrsa.Fields("RecDate"), "mm/dd/yyyy") & "#," & 1 & ")")
       adrsa.MoveNext
    Loop
End If
i = 0
'Identify all code1 in
Dim adrsb As ADODB.Recordset
Set adrsb = New ADODB.Recordset
adrsb.ActiveConnection = CurrentProject.Connection
Do
    i = i + 1
    If adrsb.State = 1 Then
        adrsb.Close
    End If
    adrsb.CursorType = adOpenStatic

    adrsb.Open "SELECT tblInScopeRestructures.Code1, tblInScopeRestructures.Gen " & _
    "FROM tblInScopeRestructures " & _
    "GROUP BY tblInScopeRestructures.Code1, tblInScopeRestructures.Gen " & _
    "HAVING (((tblInScopeRestructures.Gen)=" & i & "));"
    Dim adrsc As ADODB.Recordset
    Set adrsc = New ADODB.Recordset
    adrsc.ActiveConnection = CurrentProject.Connection
    adrsc.CursorType = adOpenStatic
    If Not adrsb.EOF Then
        adrsb.MoveLast
        adrsb.MoveFirst
    End If
    If adrsb.RecordCount <> 0 Then
        adrsb.MoveFirst
        strPrevCode1 = adrsb.Fields("Code1")
        Do While Not adrsb.EOF
            If adrsc.State = 1 Then
                adrsc.Close
            End If
            adrsc.CursorType = adOpenStatic
            adrsc.Open "SELECT tblRestructure.Code1, tblRestructure.Code2, tblRestructure.RecDate " & _
            "FROM tblRestructure " & _
            "WHERE (((tblRestructure.Code2)='" & strPrevCode1 & "'));"
            If adrsc.RecordCount <> 0 Then
            adrsc.MoveFirst
            Do While Not adrsc.EOF
           adConn.Execute ("INSERT INTO tblInScopeRestructures(Code1,Code2,RecDate,Gen) VALUES ('" & adrsc.Fields("Code1") & "','" & adrsc.Fields("Code2") & _
           "',#" & Format(adrsc.Fields("RecDate"), "mm/dd/yyyy") & "#," & i + 1 & ")")
           adrsc.MoveNext
           Loop
           End If
          adrsb.MoveNext
        Loop
    End If
Loop While adrsb.RecordCount <> 0
  Debug.Print "finished"
End Function

MS访问代码针对相同数据的每次执行给出不同的结果

0 个答案: