通过VBA获取SharePoint文档版本历史遇重复问题求助

Let's break down why you're seeing duplicate version records in your Word document even though SharePoint's native version history shows no duplicates. The core issue lies in how your VBA code clears existing version rows before inserting new data.

The Root Cause in Your Code #

Looking at the InsertVersionHistory function, this loop is intended to delete all existing version rows (keeping only the header row):

For rowIndex = 2 To oVerTbl.Rows.Count 
 oVerTbl.Rows.Item(2).Delete 
Next rowIndex

This logic breaks because deleting a row reduces the total number of rows in the table. The For loop uses the initial row count as its upper bound, so it won't catch all rows once the table shrinks. Leftover old rows get mixed with newly inserted version data, creating the "duplicate" entries you're seeing.

The Fix #

Replace that flawed row-deletion loop with a Do While loop that keeps deleting the second row until only the header row remains. This handles the dynamic row count correctly:

' Clear existing version rows (preserve the header row at index 1)
Do While oVerTbl.Rows.Count > 1
    oVerTbl.Rows(2).Delete
Loop

Revised InsertVersionHistory Function #

Here's the full corrected function with this fix, plus a minor syntax adjustment for VBA compatibility:

Private Function InsertVersionHistory(oVerTbl As Word.Table, oVersions As Office.DocumentLibraryVersions)
    Dim rowIndex As Integer
    Dim oVersion As Office.DocumentLibraryVersion
    Dim oNewRow As Row
    Dim versionIndex As Integer
    
    ' Fix: Properly clear all existing version rows except header
    Do While oVerTbl.Rows.Count > 1
        oVerTbl.Rows(2).Delete
    Loop
    
    rowIndex = 1
    versionIndex = oVersions.Count
    
    For Each oVersion In oVersions
        If (rowIndex > 5) Then Exit Function ' VBA uses Exit Function instead of Return
        rowIndex = rowIndex + 1
        
        oVerTbl.Rows.Add
        Set oNewRow = oVerTbl.Rows(oVerTbl.Rows.Count)
        
        With oNewRow
            .Shading.BackgroundPatternColor = wdColorWhite
            .Range.Font.TextColor = wdBlack
            .Range.Font.Name = "Tahoma"
            .Range.Font.Bold = False
            .Range.Font.Size = 12
            .Range.ParagraphFormat.SpaceAfter = 4
            
            .Cells(1).Range.Text = versionIndex
            .Cells(2).Range.Text = FormUserFullName(GetUserFullName(oVersion.ModifiedBy))
            .Cells(3).Range.Text = oVersion.Modified
            .Cells(4).Range.Text = oVersion.Comments
        End With
        
        versionIndex = versionIndex - 1
    Next
    
    Set oVersion = Nothing
End Function

Quick Extra Tips #

• Remove On Error Resume Next from your main macro unless you explicitly need it. It hides useful error messages that could help diagnose other issues (like problems accessing SharePoint version data or the bookmarked table).
• Add error handling around the GetObject call in GetUserFullName—if the user lookup fails, this will throw an error that's currently being hidden.

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