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

时间:2018-01-12 11:23:37

标签: vba sharepoint sharepoint-2007

这是我的问题:

重复版本

enter image description here 我检查了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

0 个答案:

没有答案