通过vba在文档中的Sharepoint版本历史记录？

Question

这是我的问题：

重复版本

我检查了 Sharepoint 网站上的版本历史记录，它没有显示任何重复项。

这是我使用的代码：

Sub versionhistory()
'
' versionhistory Macro
On Error Resume Next

' On Error GoTo message

Dim dlvVersions As Office.DocumentLibraryVersions
    Dim dlvVersion As Office.DocumentLibraryVersion
    Dim strVersionInfo As String
    Set dlvVersions = ThisDocument.DocumentLibraryVersions

   'MsgBox ActiveDocument.Bookmarks.Count

    Dim tbl As Word.Table

    'Set tbl = ActiveDocument.Tables.Item(2)
    Set tbl = ActiveDocument.Bookmarks("VersionTable").Range.Tables(1)


    If dlvVersions.IsVersioningEnabled Then
        strVersionInfo = "This document has " & dlvVersions.Count & " versions: " & vbCrLf

        Call InsertVersionHistory(tbl, dlvVersions)

        For Each dlvVersion In dlvVersions

            strVersionInfo = strVersionInfo & _
                " - Version #: " & dlvVersion.Index & vbCrLf & _
                "  - Modified by: " & dlvVersion.ModifiedBy & vbCrLf & _
                "  - Modified on: " & dlvVersion.Modified & vbCrLf & _
                "  - Comments: " & dlvVersion.Comments & vbCrLf
        Next
    Else
        strVersionInfo = "Versioning not enabled for this document."
    End If
    'MsgBox strVersionInfo, vbInformation + vbOKOnly, "Version Information"
    Set dlvVersion = Nothing
    Set dlvVersions = Nothing


Call GetUserName

'message:
'MsgBox Err.Description

MsgBox ("Insert Version Number in the Header and type a Title in the [Insert Title here] on the front page. It will be automatically updated in the footer." & vbNewLine & vbNewLine & "Do Not Type in the Review and Version tables.")

End Sub



Private Function InsertVersionHistory(oVerTbl As Word.Table, oVersions As Office.DocumentLibraryVersions)
    Dim rowIndex As Integer
    Dim oVersion As Office.DocumentLibraryVersion
    Dim oNewRow As Row
    'test
    Dim versionIndex As Integer

        For rowIndex = 2 To oVerTbl.Rows.Count

            oVerTbl.Rows.Item(2).Delete

        Next rowIndex

        rowIndex = 1

          'test
         versionIndex = oVersions.Count

For Each oVersion In oVersions

        If (rowIndex > 5) Then

        Return

        End If
        rowIndex = rowIndex + 1


        oVerTbl.Rows.Add

         Set oNewRow = oVerTbl.Rows(oVerTbl.Rows.Count)

        oNewRow.Shading.BackgroundPatternColor = wdColorWhite
        oNewRow.Range.Font.TextColor = wdBlack
        oNewRow.Range.Font.Name = "Tahoma"
        oNewRow.Range.Font.Bold = False
        oNewRow.Range.Font.Size = 12
        oNewRow.Range.ParagraphFormat.SpaceAfter = 4

        With oNewRow.Cells(1)
            '.Range.Text = oVersion.Index
            .Range.Text = versionIndex
        End With

        With oNewRow.Cells(2)
            .Range.Text = FormUserFullName(GetUserFullName(oVersion.ModifiedBy))
        End With

        With oNewRow.Cells(3)
            .Range.Text = oVersion.Modified
        End With

        With oNewRow.Cells(4)
            .Range.Text = oVersion.Comments
        End With

        versionIndex = versionIndex - 1
    Next
    Set oVersion = Nothing

End Function

Function GetUserFullName(userName As String) As String
    Dim WSHnet, UserDomain, objUser
    Set WSHnet = CreateObject("WScript.Network")
    'UserDomain = WSHnet.UserDomain
    'Set objUser = GetObject("WinNT://" & UserDomain & "/" & userName & ",user")

    userName = Replace(userName, "\", "/")



    Set objUser = GetObject("WinNT://" & userName & ",user")
    'MsgBox objUser.FullName
    GetUserFullName = objUser.FullName

End Function

Function FormUserFullName(userName As String) As String

Dim arrUserName As Variant
Dim changedUserName As String

arrUserName = Split(userName, ",")

Dim length As Integer

length = UBound(arrUserName) - LBound(arrUserName) + 1

    If length >= 2 Then
        changedUserName = arrUserName(1) & " " & arrUserName(0)
    Else
        changedUserName = userName
    End If

FormUserFullName = changedUserName

End Function


Private Function GetUserName()

Dim userName As String

userName = ActiveDocument.BuiltInDocumentProperties("Author")

 ActiveDocument.BuiltInDocumentProperties("Author") = FormUserFullName(userName)


End Function

Answer 1

我知道这很旧，但我一直在寻找同样的东西并找到了这篇文章。我仍在尝试，但想在我真正的工作分心之前分享一下。

来自：SixSigmaGuy microsoft.public.sharepoint.development-and-programming.narkive.com/...

想分享我的发现，到目前为止。令人惊讶的是，我找不到 SharePoint Designer 对象/类中支持版本的任何内容， 但 Office、Word、Excel 和 PowerPoint 对象确实支持它。它 不容易找到，但一旦我找到它，它就很好用，只要 文档库中的文件是 Office 文档之一。

这里有一些示例代码，用 Excel VBA 编写，展示了如何获取 特定 SharePoint 文档库文件的版本信息 在 Excel 中创建：

Public viRow As Long

Function fCheckVersions(stFilename As String) As Boolean
' stFilename is the full URL to a document in a Document Library.
'

    Dim wb As Excel.Workbook
    Dim dlvVersions As Office.DocumentLibraryVersions
    Dim dlvVersion As Office.DocumentLibraryVersion
    Dim stExtension As String
    Dim iPosExt As Long

    ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 1) = stFilename

    If Workbooks.CanCheckOut(stFilename) = True Then
        Set wb = Workbooks.Open(stFilename, , True)
        Set dlvVersions = wb.DocumentLibraryVersions
        If dlvVersions.IsVersioningEnabled = True Then
            ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 3) = "Num
            Versions = " & dlvVersions.Count
            For Each dlvVersion In dlvVersions
                ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 4) = "Version: " & dlvVersion.Index
                ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 5) = "Modified Date: " & dlvVersion.Modified
                ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 6) = "Modified by: " & dlvVersion.ModifiedBy
                ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 7) = "Comments: " & dlvVersion.Comments
                viRow = viRow + 1
            Next dlvVersion
        End If
        wb.Close False
    End If
    Set wb = Nothing
    DoEvents
End Function`

幸运的是，我发现 Excel 可以在大多数情况下打开非 Excel 文件 案例。例如，我可以在 Excel 中打开一个 jpg 文件并使用 该文件的 dlvVersions 集合。