如何在VBA代码中实现跨工作簿按发票号提取指定行数据？

Hey there! Great job building out this dunning email automation—personalized, batch-sent reminders are such a time-saver. Let's tackle adding that invoice log lookup functionality you need. I’ll walk you through using the Find function correctly, handling edge cases like missing invoices, and integrating everything smoothly into your existing code.

Key Changes We’ll Make #

• Set clear references for your main workbook (WB1) and invoice log (WB2)
• Use Range.Find() to locate matching invoice numbers in WB2
• Copy your 5 specified columns from WB2 to WB1
• Add error handling for when an invoice can’t be found in the log

Modified Code with Lookup Functionality #

Sub DunningEmailv2()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim invoiceNum As Variant
    Dim foundCell As Range
    Dim copyColumns As Variant ' Array for WB2 columns to copy
    Dim pasteColumns As Variant ' Array for WB1 columns to paste to
    
    ' --- Update these to match your actual files/sheets ---
    Set wb1 = ThisWorkbook ' WB1 = workbook containing this code
    ' Use this line if WB2 is already open:
    ' Set wb2 = Workbooks("InvoiceLog.xlsx")
    ' Use this line if WB2 needs to be opened from a path:
    ' Set wb2 = Workbooks.Open("C:\Your\Path\To\InvoiceLog.xlsx")
    Set ws1 = wb1.Sheets("MainData") ' WB1's sheet name
    Set ws2 = wb2.Sheets("InvoiceLog") ' WB2's sheet name
    
    ' --- Update column mappings to your needs ---
    ' Example: Copy WB2 columns F-J to WB1 columns I-M
    copyColumns = Array("F", "G", "H", "I", "J")
    pasteColumns = Array("I", "J", "K", "L", "M")
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
    On Error GoTo cleanup
    For Each cell In ws1.Columns("B").Cells.SpecialCells(xlCellTypeVisible)
        If cell.Value Like "?*@?*.?*" And _
            LCase(ws1.Cells(cell.Row, "C").Value) = "yes" Then
            
            ' Grab invoice number from WB1 column E
            invoiceNum = ws1.Cells(cell.Row, "E").Value
            
            ' Look up invoice number in WB2 (assumes invoice numbers are in WB2 column A)
            Set foundCell = ws2.Columns("A").Find(What:=invoiceNum, _
                LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                
            If Not foundCell Is Nothing Then
                ' Copy specified columns from WB2 to WB1
                Dim i As Integer
                For i = LBound(copyColumns) To UBound(copyColumns)
                    ws1.Cells(cell.Row, pasteColumns(i)).Value = _
                        ws2.Cells(foundCell.Row, copyColumns(i)).Value
                Next i
            Else
                ' Handle missing invoice (optional: add a note or skip email)
                ws1.Cells(cell.Row, "I").Value = "Invoice not found in log"
                ' Uncomment below to skip sending email for missing invoices
                ' GoTo nextCell
            End If
            
            ' --- Original email creation code (updated with sheet references) ---
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .SentOnBehalfOfName = "xxx@xxx.xxx"
                .Importance = olImportanceHigh
                .To = cell.Value
                .Subject = "Overdue Invoice Reminder from xxx"
                .Body = "Dear " & ws1.Cells(cell.Row, "A").Value & "," _
                    & vbNewLine & vbNewLine & _
                    ws1.Cells(cell.Row, "D").Value & " have an outstanding invoice numbered (" & ws1.Cells(cell.Row, "E").Value & ")" & ", amounting to $" & ws1.Cells(cell.Row, "G").Value & "." _
                    & vbNewLine & vbNewLine & _
                    "This invoice is now " & ws1.Cells(cell.Row, "H").Value & " days overdue which has become a concern for us." _
                    & vbNewLine & vbNewLine & _
                    "Please provide confirmation as to when payment will be made." _
                    & vbNewLine & vbNewLine & _
                    "If you have any questions please feel free to ask." _
                    & vbNewLine & vbNewLine & _
                    "Kind regards,"
                '.Attachments.Add ("C:\test.txt")
                .Save
                .Display
                
                ' Wait 5 seconds (with DoEvents to prevent Excel freezing)
                Dim currenttime As Date
                currenttime = Now
                Do Until Now >= currenttime + TimeValue("00:00:05")
                    DoEvents
                Loop
                
                ' Add signature via SendKeys (keep as-is since other methods failed)
                SendKeys "^+{End}", True
                SendKeys "{End}", True
                SendKeys "%nas~", True
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
nextCell:
    Next cell
    
cleanup:
    ' Close WB2 if you opened it (skip if it was already open)
    ' wb2.Close SaveChanges:=False
    Set OutApp = Nothing
    Set wb1 = Nothing
    Set wb2 = Nothing
    Application.ScreenUpdating = True
    MsgBox "Dunning emails processed!", vbInformation
End Sub

Critical Customizations for Your Setup #

1. Workbook/Sheet References: Update the wb1, wb2, ws1, and ws2 lines to match your actual file names, sheet names, and file path (if WB2 isn’t already open).
2. Column Mappings: Adjust the copyColumns and pasteColumns arrays to match where your data lives in WB2 and where you want it to go in WB1.
3. Find Function Tweaks: LookAt:=xlWhole ensures full invoice number matches—change to xlPart if you need partial matches. MatchCase:=False makes the lookup case-insensitive.
4. Missing Invoice Handling: Customize the Else block to skip emails, add a warning, or log missing invoices as needed.

Common Pitfalls to Avoid #

• Unqualified References: Always use ws1. or wb1. before Cells/Range to avoid accidentally referencing the wrong sheet.
• SendKeys Limitations: SendKeys can be unreliable if Outlook loses focus during the process—stick with it if other signature methods failed, but keep an eye out for edge cases.
• Screen Updating: We disabled it to speed up the process, but make sure the cleanup block re-enables it even if an error occurs.

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