Question

在访问2013上运行以下代码我收到系统资源错误。我的理解是该程序可能需要更多时间，但系统资源错误没有意义。我的笔记本电脑有8GB RAM和核心i3。有一个更好的方法吗？使用的值：

me.yearsback = 1
me.valdate = 5/31/2016
me.period =＆＃34;每月＆＃34; 更新：首先使用0.5M行，产生系统资源错误。但是，当我减少行数时，运行正常。

Option Compare Database

Private Sub Calculate_Click()
    Dim db As Database
    Dim rs As Recordset
    Dim x As Integer
    Dim y As Integer
    Dim Months As Integer
    Dim WPmonthly As String ' field name for monthly written premium
    Dim UPRmonthly As String ' field name for monthly unearned premium
    Dim EPmonthly As String ' field name for monthly earned premium
    Dim runningDate As Date
    Dim runningDate2 As Date
    Dim useDateLower As Date
    Dim useDateUpper As Date

    Months = Me.YearsBack * 12 + Month(Me.ValDate)

    If Me.Period = "monthly" Then
        Set db = CurrentDb
        For x = 1 To Months
            runningDate = Format(DateAdd("m", -x + 1, Me.ValDate), "mm yyyy")
            WPmonthly = "WP M" & Month(runningDate) & " " & Year(runningDate)
            EPmonthly = "EP M" & Month(runningDate) & " " & Year(runningDate)
            UPRmonthly = "UPR M" & Month(runningDate) & " " & Year(runningDate)
            db.Execute "ALTER TABLE tblEPdata ADD COLUMN [" & WPmonthly & "] STRING;"
            db.Execute "ALTER TABLE tblEPdata ADD COLUMN [" & EPmonthly & "] STRING;"
            db.Execute "ALTER TABLE tblEPdata ADD COLUMN [" & UPRmonthly & "] STRING;"
            If x = Months Then
                runningDate = Format(DateAdd("m", -x, Me.ValDate), "mm yyyy")
                UPRmonthly = "UPR M" & Month(runningDate) & " " & Year(runningDate)
                db.Execute "ALTER TABLE tblEPdata ADD COLUMN [" & UPRmonthly & "] STRING;"
            End If
        Next

        For y = 1 To Months
            runningDate2 = Format(DateAdd("m", -y + 1, Me.ValDate), "mm yyyy")
            useDateLower = runningDate2
            useDateUpper = Format(DateAdd("m", -y + 2, Me.ValDate), "mm yyyy")
            WPmonthly = "WP M" & Month(runningDate2) & " " & Year(runningDate2)
            EPmonthly = "EP M" & Month(runningDate2) & " " & Year(runningDate2)
            UPRmonthly = "UPR M" & Month(runningDate2) & " " & Year(runningDate2)
            Set rs = db.OpenRecordset("tblEPdata", dbOpenDynaset, dbSeeChanges)

            Do Until rs.EOF

                'Written Premium Calculation

                If rs!issueDate < useDateUpper And rs!issueDate >= useDateLower Then
                    rs.Edit
                    rs.Fields(WPmonthly) = rs!grossPremium
                    rs.Update
                End If

                'UPR Calculation

                If rs!issueDate < Me.ValDate Then
                    If rs!expiryDate < useDateUpper Then
                        rs.Edit
                        rs.Fields(UPRmonthly) = 0
                        rs.Update
                    ElseIf rs!effectiveDate < useDateUpper Then
                        rs.Edit
                        rs.Fields(UPRmonthly) = (rs!expiryDate - useDateUpper + 1) / (rs!expiryDate - rs!effectiveDate + 1) * rs!grossPremium
                        rs.Update
                    ElseIf rs!effectiveDate >= useDateUpper Then
                        rs.Edit
                        rs.Fields(UPRmonthly) = rs!grossPremium
                        rs.Update
                    Else:
                        rs.Edit
                        rs.Fields(UPRmonthly) = rs!grossPremium
                        rs.Update
                    End If
                End If

                rs.MoveNext

            Loop
            rs.Close
        Next
    End If
    db.Close
End Sub

vba访问超出系统资源错误

0 个答案: