Sharepoint version history in document via vba?

Question

Here is my problem:

Duplicate versions

I checked the version history on the Sharepoint site and it doesn't show any duplicates.

Here is the code im using:

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

I know this is old, but I was looking for the same thing and found this article. I'm still trying it out, but wanted to share before I got distracted with my real job.

From: SixSigmaGuy on microsoft.public.sharepoint.development-and-programming.narkive.com/...

Wanted to share my findings, so far. Surprisingly, I could not find anything in the SharePoint Designer object/class that supported versions, but the Office, Word, Excel, and PowerPoint objects do support it.. It wasn't easy to find, but once I found it, it works great, as long as the file in the document library is one of the Office documents.

Here's some sample code, written in Excel VBA, showing how to get the version information for a paritcular SharePoint Document Library file created in 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`

Fortunately, I discovered that Excel can open non-Excel files in most cases. I.e., I can, for example, open a jpg file in Excel and use the dlvVersions collection for that file.