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

我有一个在Sharepoint文档库中版本化的Excel书籍，这样我就可以进入“文件”选项卡并查看以下版本：

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

您可以通过打开文件的历史版本来获取这些信息，其文件名将是filename .xlsx，版本xx.yy ： modified date ，以便xx.yy将成为major.minor格式的版本号。

我已经把我在下面使用的代码。 它将版本名称放在打开的工作表的H列中。 检查中有一点错误，但不足以直接使用。 最重要的是，它假定它粘贴的电子表格是唯一打开的电子表格。 你也希望拥有你想要closures的版本号的文件。

 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