1

我正在尝试从我继承此 Access 数据库的人那里修复一些拙劣的 VBA。除了 VBA 中几乎没有用的注释之外，没有任何文档，所以我试图弄清楚一切都是做什么的，以及它是否正确。当我单击按钮以将单位或值添加到贡献表时，我继续收到 13Type Mismatch 错误。我认为这是一个简单的修复，例如搞砸了变量声明，但是我已将它们更改为 Double，它似乎并没有纠正我的错误。有没有人看到他们可能认为抛出这个错误的任何东西？提前感谢您的努力。

    Private Sub AddContributionBtn_Click()
    On Error GoTo Err_AddContributionBtn

  Dim Cancel As Integer
  Dim CurrentNAVDate As Date
  Dim CurrentNAV As Double
  Dim ConfirmAddCont As Double
  Dim CalcContUnits As Double
  Dim CalcContValue As Double
  Dim StringSQL As String

    'get current NAV
    CurrentNAVDate = Format(DateAdd("s", -1, DateAdd("q", DateDiff("q", "1/1/1900", Date),             "1/1/1900")), "Short Date")
    CurrentNAV = Format(DLookup("NetAssetValue", "NAV_Tbl", "Format(NAV_Date, ""mmddyyyy"") = " & Format(CurrentNAVDate, "mmddyyyy")), "Currency")

    'validation to require either contribution units or value is entered, not both
    If IsNull(Me.ContValueTxt) = True And IsNull(Me.ContUnitsTxt) = True Then
        MsgBox "Please enter contribution units or value."
        Me.ContUnitsTxt.SetFocus
        Cancel = True
        Exit Sub
    ElseIf IsNull(Me.ContValueTxt) = False And IsNull(Me.ContUnitsTxt) = False Then
        MsgBox "Both contribution units and value may not be entered."
        Me.ContUnitsTxt.SetFocus
        Cancel = True
        Exit Sub
    Else:
        If IsNull(Me.ContValueTxt) = True And IsNull(Me.ContUnitsTxt) = False Then
            'calculate contribution value from units
            CalcContUnits = Me.ContUnitsTxt
            CalcContValue = CalcContUnits * CurrentNAV

            GoTo ConfirmAppend

        ElseIf IsNull(Me.ContValueTxt) = False And IsNull(Me.ContUnitsTxt) = True Then
            'calculate contribution units from value
            CalcContValue = Me.ContValueTxt
            CalcContUnits = CalcContValue / CurrentNAV

            GoTo ConfirmAppend
        End If
    End If

 ConfirmAppend:
    'confirm contribution value and units, run append query
    ConfirmAddCont = MsgBox("Add " & Format(CalcContUnits, "fixed") & " units for a      contribution value of " & Format(CalcContValue, "currency") & "?", _
    vbOKCancel, "Add Contribution")
    If ConfirmAddCont = vbOK Then
        DoCmd.Hourglass True
        DoCmd.SetWarnings False
            StringSQL = "INSERT INTO ContributionTbl(ContDate, ContUnits, ContNAV,   ContType) VALUES (#" & Date & "#, " & CalcContUnits & ", #" & CurrentNAVDate & "#, " & 1 & ");"
            DoCmd.RunSQL (StringSQL)
        DoCmd.SetWarnings True
        DoCmd.Hourglass False

        Me.ContUnitsTxt = Null
        Me.ContValueTxt = Null
        Forms!PlanFrm![PlanContributedUnitsFrm].Requery
    Else
        Cancel = True
        Exit Sub
    End If

 Exit_AddContributionBtn:
    Exit Sub
 Err_AddContributionBtn:
    MsgBox Err.Number & Err.Description
    Resume Exit_AddContributionBtn
 End Sub
4

1 回答 1

0

如讨论中所示，我在这个临时回复中使我们的猜测更加清晰：

错误可能在这里：

CurrentNAV = Format(DLookup("NetAssetValue", "NAV_Tbl", "Format(NAV_Date, ""mmddyyyy"") = " & Format(CurrentNAVDate, "mmddyyyy")), "Currency")

当 DLookup("NetAssetValue",...) 为 NULL 时，

Format(NULL, "Currency") 得到 13 Type Mismatch，因为我在 Access 2007 中重现了这一点。

这可以解释为：由于表字段 NAV_Tbl.NetAssetValue 中没有最近的日期，因此我们得到的日期 CurrentNAVDate = 09/30/2013（上个季度的最后日期）。

因此，您可以尝试这样的代码，通过引入varCurrency变量来处理这种 NULL 值情况：

Private Sub AddContributionBtn_Click()

  On Error GoTo Err_AddContributionBtn

  Dim Cancel As Integer
  Dim CurrentNAVDate As Date
  Dim CurrentNAV As Double
  Dim ConfirmAddCont As Double
  Dim CalcContUnits As Double
  Dim CalcContValue As Double
  Dim StringSQL As String

  Dim varCurrency

  'get current NAV
  CurrentNAVDate = Format(DateAdd("s", -1, DateAdd("q", DateDiff("q", "1/1/1900", Date),             "1/1/1900")), "Short Date")
  varCurrency = DLookup("NetAssetValue", "NAV_Tbl", "Format(NAV_Date, ""mmddyyyy"") = " & Format(CurrentNAVDate, "mmddyyyy"))
  If(IsNull(varCurrency) then
    CurrentNAV = 0
  Else
    CurrentNAV = Format(varCurrency, "Currency")
  End If

  'validation to require either contribution units or value is entered, not both
  If IsNull(Me.ContValueTxt) = True And IsNull(Me.ContUnitsTxt) = True Then
    MsgBox "Please enter contribution units or value."
    Me.ContUnitsTxt.SetFocus
    Cancel = True
    Exit Sub
  ElseIf IsNull(Me.ContValueTxt) = False And IsNull(Me.ContUnitsTxt) = False Then
    MsgBox "Both contribution units and value may not be entered."
    Me.ContUnitsTxt.SetFocus
    Cancel = True
    Exit Sub
  Else:
    If IsNull(Me.ContValueTxt) = True And IsNull(Me.ContUnitsTxt) = False Then
      'calculate contribution value from units
      CalcContUnits = Me.ContUnitsTxt
      CalcContValue = CalcContUnits * CurrentNAV

      GoTo ConfirmAppend

    ElseIf IsNull(Me.ContValueTxt) = False And IsNull(Me.ContUnitsTxt) = True Then
      'calculate contribution units from value
      CalcContValue = Me.ContValueTxt
      CalcContUnits = CalcContValue / CurrentNAV

      GoTo ConfirmAppend
    End If
  End If

ConfirmAppend:
  'confirm contribution value and units, run append query
  ConfirmAddCont = MsgBox("Add " & Format(CalcContUnits, "fixed") & " units for a      contribution value of " & Format(CalcContValue, "currency") & "?", _
  vbOKCancel, "Add Contribution")
  If ConfirmAddCont = vbOK Then
    DoCmd.Hourglass True
    DoCmd.SetWarnings False
    StringSQL = "INSERT INTO ContributionTbl(ContDate, ContUnits, ContNAV,   ContType) VALUES (#" & Date & "#, " & CalcContUnits & ", #" & CurrentNAVDate & "#, " & 1 & ");"
    DoCmd.RunSQL (StringSQL)
    DoCmd.SetWarnings True
    DoCmd.Hourglass False

    Me.ContUnitsTxt = Null
    Me.ContValueTxt = Null
    Forms!PlanFrm![PlanContributedUnitsFrm].Requery
  Else
    Cancel = True
    Exit Sub
  End If

Exit_AddContributionBtn:
  Exit Sub
Err_AddContributionBtn:
  MsgBox Err.Number & Err.Description
  Resume Exit_AddContributionBtn
End Sub

对于 DLookup()：

varCurrency = DLookup("NetAssetValue", "NAV_Tbl", "NAV_Date >= #" & Format(CurrentNAVDate, "yyyy-mm-dd") & "#")
于 2013-11-08T22:07:55.457 回答