新增客户自动识别并开具发送发票的VBA宏开发需求

基础问题修正 #

原代码存在重复变量声明（如CompanyCoordEmail、ContractEnd重复定义）、未使用变量冗余问题，先清理这些问题可避免编译报错。

核心功能实现逻辑 #

要完成“识别客户表新增带唯一发票号的客户，对比发票记录表后执行对应操作”，需覆盖以下环节：

• 用工作表名称替代Sheet1/Sheet2/Sheet4，增强代码可读性与维护性
• 遍历客户表中所有带发票号的条目
• 检查当前客户的发票号是否已记录（支持两种判断逻辑：对比记录表最后一行/全表查重）
• 仅对未记录的发票号执行开票、发邮件、日志记录流程

修改后的完整代码 #

Option Explicit

Sub AutoProcessNewInvoices()
    ' 定义工作表对象，需替换为实际工作表名称
    Dim wsCustomer As Worksheet ' 客户表
    Dim wsInvoice As Worksheet ' 发票模板表（用于生成PDF）
    Dim wsRecord As Worksheet ' 发票记录表
    Set wsCustomer = ThisWorkbook.Worksheets("客户表")
    Set wsInvoice = ThisWorkbook.Worksheets("发票表")
    Set wsRecord = ThisWorkbook.Worksheets("发票记录表")
    
    Dim EApp As Object
    Dim EItem As Object
    
    ' 数据变量
    Dim CompanyID As String
    Dim CompanyName As String
    Dim ContractedTrainees As String
    Dim InvoiceNo As String
    Dim CompanyCoordName As String
    Dim CompanyCoordEmail As String
    Dim ContractStart As Date
    Dim ContractEnd As Date
    Dim ContractPrice As Currency
    Dim Discount As String
    Dim Total As Currency
    Dim Path As String
    Dim FName As String
    Dim nextrec As Range
    Dim lastRowCustomer As Long
    Dim lastRowRecord As Long
    Dim i As Long
    Dim isInvoiceExists As Boolean
    
    ' 发票存储路径
    Path = "C:\Users\owaism\OneDrive\P1\Project Management\Sales\Invoice\Invoices\"
    
    ' 获取客户表最后一行行号（假设发票号在B列，需根据实际调整）
    lastRowCustomer = wsCustomer.Cells(wsCustomer.Rows.Count, "B").End(xlUp).Row
    ' 获取发票记录表最后一行行号（假设发票号在D列）
    lastRowRecord = wsRecord.Cells(wsRecord.Rows.Count, "D").End(xlUp).Row
    
    ' 遍历客户表条目（从第2行开始，假设第1行是表头）
    For i = 2 To lastRowCustomer
        InvoiceNo = wsCustomer.Cells(i, "B").Value
        If InvoiceNo <> "" Then ' 仅处理有发票号的条目
            isInvoiceExists = False
            
            ' 逻辑1：仅对比发票记录表最后一行的发票号（符合原始需求）
            If wsRecord.Cells(lastRowRecord, "D").Value = InvoiceNo Then
                isInvoiceExists = True
            End If
            
            ' 逻辑2：检查整个记录表是否存在该发票号（更严谨，推荐使用）
            ' If Not wsRecord.Range("D:D").Find(What:=InvoiceNo, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
            '     isInvoiceExists = True
            ' End If
            
            ' 发票未记录则执行流程
            If Not isInvoiceExists Then
                ' 从客户表读取数据（需根据实际列位置调整）
                CompanyID = wsCustomer.Cells(i, "C").Value
                CompanyName = wsCustomer.Cells(i, "D").Value
                ContractedTrainees = wsCustomer.Cells(i, "E").Value
                CompanyCoordName = wsCustomer.Cells(i, "F").Value
                CompanyCoordEmail = wsCustomer.Cells(i, "G").Value
                ContractStart = wsCustomer.Cells(i, "H").Value
                ContractEnd = wsCustomer.Cells(i, "I").Value
                ContractPrice = wsCustomer.Cells(i, "J").Value
                Discount = wsCustomer.Cells(i, "K").Value
                Total = wsCustomer.Cells(i, "L").Value
                
                ' 将数据写入发票模板表对应单元格
                wsInvoice.Range("C6").Value = CompanyID
                wsInvoice.Range("C7").Value = CompanyName
                wsInvoice.Range("A20").Value = ContractedTrainees
                wsInvoice.Range("D32").Value = InvoiceNo
                wsInvoice.Range("C9").Value = CompanyCoordName
                wsInvoice.Range("C10").Value = CompanyCoordEmail
                wsInvoice.Range("F24").Value = ContractStart
                wsInvoice.Range("B24").Value = ContractEnd
                wsInvoice.Range("C20").Value = ContractPrice
                wsInvoice.Range("D20").Value = Discount
                wsInvoice.Range("D27").Value = Total
                
                ' 生成PDF文件名并导出
                FName = CompanyID & " - " & InvoiceNo
                wsInvoice.ExportAsFixedFormat Type:=xlTypePDF, IgnorePrintAreas:=False, Filename:=Path & FName
                
                ' 记录到发票记录表
                Set nextrec = wsRecord.Cells(lastRowRecord + 1, "A")
                nextrec.Value = CompanyID
                nextrec.Offset(0, 1).Value = CompanyName
                nextrec.Offset(0, 2).Value = ContractedTrainees
                nextrec.Offset(0, 3).Value = InvoiceNo
                nextrec.Offset(0, 4).Value = CompanyCoordName
                nextrec.Offset(0, 5).Value = CompanyCoordEmail
                nextrec.Offset(0, 6).Value = ContractStart
                nextrec.Offset(0, 7).Value = ContractEnd
                nextrec.Offset(0, 8).Value = ContractPrice
                nextrec.Offset(0, 9).Value = Discount
                nextrec.Offset(0, 10).Value = Total
                
                ' 添加PDF和文件链接
                wsRecord.Hyperlinks.Add Anchor:=nextrec.Offset(0, 11), Address:=Path & FName & ".pdf", TextToDisplay:="PDF发票"
                wsRecord.Hyperlinks.Add Anchor:=nextrec.Offset(0, 12), Address:=Path & FName & ".xlsx", TextToDisplay:="源文件"
                
                ' 发送邮件
                Set EApp = CreateObject("Outlook.Application")
                Set EItem = EApp.CreateItem(0)
                With EItem
                    .To = CompanyCoordEmail
                    .Subject = "Invoice No: " & InvoiceNo
                    .Body = "Please find Invoice attached."
                    .Attachments.Add (Path & FName & ".pdf")
                    .Send ' 改为.Display可预览邮件后再发送
                End With
                
                ' 更新记录表最后一行行号
                lastRowRecord = lastRowRecord + 1
                
                ' 清理发票模板表数据（可选）
                wsInvoice.Range("C6").ClearContents
                wsInvoice.Range("C7").ClearContents
            End If
        End If
    Next i
    
    ' 释放对象避免内存泄漏
    Set EItem = Nothing
    Set EApp = Nothing
    Set wsCustomer = Nothing
    Set wsInvoice = Nothing
    Set wsRecord = Nothing
    
    MsgBox "新增发票处理完成", vbInformation
End Sub

关键说明 #

1. 工作表名称替换：需将代码中Worksheets("客户表")等语句的名称改为实际工作簿中的工作表名称。
2. 列位置调整：客户表的各数据列位置需根据实际结构修改，比如wsCustomer.Cells(i, "C").Value中的列标识。
3. 发票号判断逻辑：提供两种可选逻辑，可根据需求注释/取消注释切换。
4. 邮件发送设置：若需要先预览邮件再发送，将.Send改为.Display即可。

内容的提问来源于stack exchange，提问作者mazen