PAYATHON 2026

如何将 One Payment 应用于 Multiple Invoices

支付小周

结论

分摊付款时，每张发票的实际付款额应按下面的公式计算：

本次应用金额 = Min(剩余付款, 发票未付金额)

计算完成后，只从剩余付款中扣除本次实际应用的金额。原代码在部分付款分支中写入了 rs!Charges - kBr，同时始终执行 kBr = kBr - rs!Charges，导致部分付款金额和剩余余额都不正确。

还要保证每轮循环都会执行 rs.MoveNext。否则，遇到已关闭或金额为零的记录时，循环可能一直停留在同一条记录上。

推荐实现

以下代码基于这些前提：

  • rs!Utility 是发票 ID。
  • rs!Charges 是发票当前的未付金额，不是原始总额。
  • rs 已按付款顺序排序。
  • advbill 和 bilid 的类型是 Long。
  • 金额字段的类型是 Currency。
  • advmode 和 payref 是文本字段，长度需要根据实际表结构调整。
Dim db As DAO.Database
Dim ws As DAO.Workspace
Dim qInsert As DAO.QueryDef
Dim qUpdate As DAO.QueryDef

Dim remainingPayment As Currency
Dim outstanding As Currency
Dim appliedAmount As Currency
Dim invoiceClosed As Boolean

On Error GoTo PaymentError

Set ws = DBEngine.Workspaces(0)
Set db = CurrentDb

Set qInsert = db.CreateQueryDef("", _
    "PARAMETERS " & _
    "pBill Long, " & _
    "pDate DateTime, " & _
    "pAmount Currency, " & _
    "pMode Text(50), " & _
    "pReference Text(255);" & _
    "INSERT INTO advdep " & _
    "    (advbill, advdate, adv_amt, advmode, payref) " & _
    "VALUES " & _
    "    (pBill, pDate, pAmount, pMode, pReference);")

Set qUpdate = db.CreateQueryDef("", _
    "PARAMETERS " & _
    "pAmount Currency, " & _
    "pClosed YesNo, " & _
    "pBill Long;" & _
    "UPDATE invoice " & _
    "SET paidamt = Nz(paidamt, 0) + pAmount, " & _
    "    closed = pClosed " & _
    "WHERE bilid = pBill;")

remainingPayment = Nz(Me.Payment, 0)

If remainingPayment <= 0 Then
    Exit Sub
End If

ws.BeginTrans

Do Until rs.EOF Or remainingPayment <= 0

    outstanding = Nz(rs!Charges, 0)

    If outstanding > 0 Then

        If remainingPayment >= outstanding Then
            appliedAmount = outstanding
        Else
            appliedAmount = remainingPayment
        End If

        invoiceClosed = (appliedAmount >= outstanding)

        With qInsert
            .Parameters!pBill = CLng(rs!Utility)
            .Parameters!pDate = AdvDate
            .Parameters!pAmount = appliedAmount
            .Parameters!pMode = Advmode
            .Parameters!pReference = payref
            .Execute dbFailOnError
        End With

        With qUpdate
            .Parameters!pAmount = appliedAmount
            .Parameters!pClosed = invoiceClosed
            .Parameters!pBill = CLng(rs!Utility)
            .Execute dbFailOnError
        End With

        remainingPayment = remainingPayment - appliedAmount

    End If

    rs.MoveNext
Loop

ws.CommitTrans

qInsert.Close
qUpdate.Close
Set qInsert = Nothing
Set qUpdate = Nothing
Set db = Nothing
Set ws = Nothing

Exit Sub

PaymentError:
    If Not ws Is Nothing Then
        If ws.Transactions Then
            ws.Rollback
        End If
    End If

    MsgBox "付款分配失败：" & Err.Description, vbExclamation

计算过程

假设付款金额为 1000，循环中的计算结果如下：

InvoiceID未付金额本次应用应用后剩余付款
1200200800
2400400400
3300300100
45001000

第四张发票实际收到 100，不能标记为关闭，剩余未付金额是 400。

原代码需要修正的关键位置

如果只做最小范围的修改，至少应将核心逻辑改成：

Dim appliedAmount As Currency

If kBr >= rs!Charges Then
    appliedAmount = rs!Charges
ElseIf kBr > 0 Then
    appliedAmount = kBr
Else
    Exit Do
End If

'写入 appliedAmount，而不是 rs!Charges - kBr

kBr = kBr - appliedAmount

原代码使用下面的表达式计算部分付款金额：

rs!Charges - kBr

处理第四张发票时，计算结果是：

500 - 100 = 400

实际应写入的付款金额是 100。因此，这里应使用 kBr，也可以统一使用计算后的 appliedAmount。

注意事项

明确指定排序

只有在 Recordset 中明确写出 ORDER BY，“按顺序应用”才有可靠的顺序。例如：

ORDER BY InvoiceID

如果付款顺序取决于开票日期、到期日或优先级，就应使用相应字段排序，并把唯一字段作为第二个排序条件：

ORDER BY DueDate, InvoiceID

不要依赖表的自然记录顺序。

使用未付金额，而不是原始金额

如果 rs!Charges 保存的是发票总额，而该发票之前已经收到过付款，需要先计算未付金额：

Outstanding = Amount - Nz(paidamt, 0)

否则，同一张发票可能被重复收款。

不要在循环中使用 DLookup

打开 rs 时，可以直接筛选尚未关闭的发票：

WHERE closed = False

这能减少重复查询，也可以避免 DLookup 返回 Null 后影响条件判断。

使用事务

插入付款明细和更新发票余额是同一笔业务操作，应放在一个事务中。任何一条 SQL 执行失败时，事务会回滚此前已经写入的数据，避免出现付款记录已经插入、发票余额却没有更新的情况。

参数类型要与表结构一致

示例使用的 Long、Currency 和文本长度只是常见配置。实际使用时，应按照 advdep 和 invoice 表的真实字段类型调整参数声明。

备注：内容仅供参考。