Excel宏数据批量导入问题：重复复制与时间限制失效的解决方案

Hey there, let's tackle those two frustrating issues with your PO import macro step by step. The core problem with your current setup is that you're relying on timestamps alone to track what's been imported—either just grabbing the newest file (which causes duplicates) or limiting to a short time window (which misses files if you open the master later).

The best solution is to track every file you've already imported in a hidden log sheet within your master file. This way, you'll never re-import a file unless you explicitly want to (like if it's been updated), and you won't miss any files no matter how long between master file openings.

Step 1: Set Up an Import Log Sheet #

First, create a hidden sheet to keep track of imported files:

• Open your masterfile.xlsm
• Insert a new worksheet (right-click a sheet tab > Insert > Worksheet)
• Name it ImportLog
• In cell A1, type FileName; in B1, type ImportDateTime
• Right-click the ImportLog tab > select Hide to keep it out of the way

Step 2: Updated VBA Macro Code #

Replace your existing up sub with this revised code. It checks the log sheet to skip already-imported files, and records every new file it processes:

Sub ImportNewPOFiles()
    Dim myDir As String, fileExt As String
    Dim myFile As String
    Dim wsMaster As Worksheet, wsLog As Worksheet
    Dim lastRowMaster As Long, lastRowLog As Long
    Dim fileIsImported As Boolean
    Dim i As Long
    
    ' Define your target folder and file types (matches .xls and .xlsx)
    myDir = "C:\Users\National\Desktop\TEST Codes\PO\Excel\"
    fileExt = "*.xls*"
    
    ' Ensure folder path ends with a backslash
    If Right(myDir, 1) <> "\" Then myDir = myDir & "\"
    
    ' Reference your master data sheet and log sheet
    Set wsMaster = ThisWorkbook.Worksheets("sheet1")
    On Error Resume Next
    Set wsLog = ThisWorkbook.Worksheets("ImportLog")
    On Error GoTo 0
    
    ' Auto-create log sheet if it doesn't exist
    If wsLog Is Nothing Then
        Set wsLog = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsLog.Name = "ImportLog"
        wsLog.Range("A1:B1").Value = Array("FileName", "ImportDateTime")
        wsLog.Visible = xlSheetHidden ' Hide the log sheet automatically
    End If
    
    ' Speed up macro by disabling screen updates/alerts
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Loop through all Excel files in the target folder
    myFile = Dir(myDir & fileExt)
    Do While myFile <> ""
        ' Skip the master file itself to avoid circular imports
        If myFile <> ThisWorkbook.Name Then
            fileIsImported = False
            lastRowLog = wsLog.Range("A" & wsLog.Rows.Count).End(xlUp).Row
            
            ' Check if this file has already been imported
            For i = 2 To lastRowLog
                If wsLog.Range("A" & i).Value = myFile Then
                    fileIsImported = True
                    Exit For
                End If
            Next i
            
            ' If not imported, copy the data
            If Not fileIsImported Then
                With Workbooks.Open(Filename:=myDir & myFile, ReadOnly:=True)
                    ' Copy the specified range from the source file
                    .Sheets("DETAILED").Range("A3:S15").Copy
                    ' Find the next empty row in the master sheet
                    lastRowMaster = wsMaster.Range("R" & wsMaster.Rows.Count).End(xlUp).Row + 1
                    ' Paste values and number formats (adjust if you need formulas/formatting)
                    wsMaster.Range("A" & lastRowMaster).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    ' Close the source file without saving
                    .Close SaveChanges:=False
                End With
                
                ' Log the imported file with timestamp
                lastRowLog = wsLog.Range("A" & wsLog.Rows.Count).End(xlUp).Row + 1
                wsLog.Range("A" & lastRowLog).Value = myFile
                wsLog.Range("B" & lastRowLog).Value = Now()
            End If
        End If
        ' Get the next file in the folder
        myFile = Dir
    Loop
    
    ' Clean up and save the master file
    Application.CutCopyMode = False
    ThisWorkbook.Save
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Import finished successfully!", vbInformation
End Sub

Step 3: Make the Macro Run on Open #

To keep the auto-run behavior you had before, add this to your ThisWorkbook module:

1. Press Alt + F11 to open the VBA editor
2. Double-click ThisWorkbook in the Project Explorer
3. Paste this code:

Private Sub Workbook_Open()
    ImportNewPOFiles
End Sub

Bonus: Handle Updated Files (Optional) #

If you want to re-import files that have been modified since their last import, modify the check loop in the macro to compare the file's last modified time with the import timestamp. Replace the existing check block with this:

' Check if this file has already been imported, or if it's been updated
For i = 2 To lastRowLog
    If wsLog.Range("A" & i).Value = myFile Then
        ' If the file was modified after it was imported, mark it for re-import
        If FileDateTime(myDir & myFile) > wsLog.Range("B" & i).Value Then
            ' Delete the old log entry so we can re-import
            wsLog.Rows(i).Delete
            lastRowLog = lastRowLog - 1
            i = i - 1 ' Adjust loop index after deleting a row
        Else
            fileIsImported = True
        End If
        Exit For
    End If
Next i

This way, any file that's been changed since its last import will be processed again.

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