这是我的问题:
重复版本
我检查了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