如何获取Excel工作簿的版本号？

Question

我有一本在Sharepoint文档库中版本化的Excel图书，这样我就可以转到File选项卡并查看如下版本：

19.0: 11/10/2014 1:15 PM by xyz\tkl2
17.0: 10/12/2014 3:54 PM by xyz\tkl2
14.0: 10/11/2014 2:23 PM by xyz\92jf

我想检索最近的版本号，在本例中是19.0。我尝试使用以下代码：

Sub getVersions()

Dim DocVersions As DocumentLibraryVersions
Dim DVersion As DocumentLibraryVersion

Set DocVersions = ThisWorkbook.DocumentLibraryVersions

For Each DVersion In DocVersions
    Debug.Print DVersion.Index
    Debug.Print DVersion.Comments
    Debug.Print DVersion.Creator
    Debug.Print DVersion.Modified
    Debug.Print DVersion.ModifiedBy
    Debug.Print DVersion.Application
Next

End Sub

对于特定的文档版本，这是每个可能获得的属性。但这些属性中没有一个检索实际版本号；例如，.Index只检索这些版本的1、2和3。有办法找到实际的版本号吗？

Answer 1

您可以通过打开文件的历史版本来获取这些信息，它的文件名将是versionxx.yymodified date，filename.xlsx，因此xx.yy将是major.minor格式的版本号。

我把我用的代码放在下面。它将版本号放在打开的工作表的H列中。它有一个小错误签入，但不足以直接使用。最重要的是，它假定它粘贴到的电子表格是唯一打开的电子表格。您也想要关闭文件的版本号。

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 VersionWorksheet As Excel.Worksheet
Dim dlvVersions As Office.DocumentLibraryVersions
Dim dlvVersion As Office.DocumentLibraryVersion
Dim OldVersion As Excel.Workbook
Dim stExtension As String
Dim iPosExt As Long

viRow = 3
ThisWorkbook.Worksheets("Index").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.Windows(1).Visible = False
        ThisWorkbook.Worksheets("Index").Cells(viRow, 3) = "Num"
        Versions = " & dlvVersions.Count"
        On Error GoTo VersionFailed:
        For Each dlvVersion In dlvVersions
            ThisWorkbook.Worksheets("Index").Cells(viRow, 4) = "Version: " & dlvVersion.Index
            ThisWorkbook.Worksheets("Index").Cells(viRow, 5) = "Modified Date: " & dlvVersion.Modified
            ThisWorkbook.Worksheets("Index").Cells(viRow, 6) = "Modified by: " & dlvVersion.ModifiedBy
            ThisWorkbook.Worksheets("Index").Cells(viRow, 7) = "Comments: " & dlvVersion.Comments
                Set OldVersion = dlvVersion.Open()
                ThisWorkbook.Worksheets("Index").Cells(viRow, 8) = "FileName: " & OldVersion.Name
                If Workbooks.Count > 2 Then
                    Workbooks(3).Close SaveChanges:=False
                End If
            viRow = viRow + 1
        GoTo NextVersion:
VersionFailed:
        ThisWorkbook.Windows(1).Visible = True
        MsgBox "Fail"
NextVersion:
        Next dlvVersion
    End If
    wb.Close False
End If
Set wb = Nothing
DoEvents
End Function