Question

我正在尝试从我继承此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

Answer 1

如讨论所示，我在这个临时反应中让我们的猜测更清晰：

错误可能在这里：

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

因为DLookup（“NetAssetValue”，...）变为NULL，

格式化（NULL，“货币”）得到13类型不匹配，因为我在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") & "#")

13Type Mismatch Access 2007

1 个答案: