如何得到excel的具体版本号(打过SP的那种)？

逝去的瞬间

不是用application.Version得到的那个，我需要的是这种，比如excel 2003 打过sp2之后是 11.6568

逝去的瞬间

up~~~~~~~~~~~~~~~~~~~~~~

tianying

这个要用到API了

Option Explicit
   
  Private Declare Function GetFileVersionInfo Lib "Version.dll" _
        Alias "GetFileVersionInfoA" _
        (ByVal lptstrFilename As String, _
        ByVal dwhandle As Long, _
        ByVal dwlen As Long, _
        lpData As Any) As Long
   
  Private Declare Function GetFileVersionInfoSize Lib "Version.dll" _
        Alias "GetFileVersionInfoSizeA" _
        (ByVal lptstrFilename As String, _
        lpdwHandle As Long) As Long
   
  Private Declare Function VerQueryValue Lib "Version.dll" _
        Alias "VerQueryValueA" _
        (pBlock As Any, _
        ByVal lpSubBlock As String, _
        lplpBuffer As Any, _
        puLen As Long) As Long
   
  Private Declare Function GetSystemDirectory Lib "KERNEL32" _
        Alias "GetSystemDirectoryA" _
        (ByVal Path As String, _
        ByVal cbBytes As Long) As Long
   
  Private Declare Sub MoveMemory Lib "KERNEL32" _
        Alias "RtlMoveMemory" _
        (dest As Any, _
        ByVal Source As Long, _
        ByVal Length As Long)
   
  Private Declare Function lstrcpy Lib "KERNEL32" _
        Alias "lstrcpyA" _
        (ByVal lpString1 As String, _
        ByVal lpString2 As Long) As Long
   
  Private sVersionInfo(11)     As String
   
  Public Enum VersionInfo
   
          CompanyName = 0
          FileDescription = 1
          FileVersion = 2
          InternalName = 3
          LegalCopyright = 4
          OriginalFileName = 5
          ProductName = 6
          ProductVersion = 7
          LegalTrademarks = 8
          PrivateBuild = 9
          SpecialBuild = 10
          Comments = 11
  End Enum
   
 
  Public Function sGetProductProperty(ByVal sFileName As String, ByVal vItem As VersionInfo) As String
   
          On Error Resume Next
           
          Dim Buffer As String
          Dim nRet   As Long
          Dim sFullFileName As String
          Dim lBufferLen As Long
          Dim lDummy As Long
          Dim sBuffer() As Byte
          Dim lVerPointer As Long
          Dim sTemp As String
          Dim bytBuffer(255) As Byte
          Dim sLang_Charset_String As String
          Dim lHexNumber As Long
           
          If sFileName = "" Then
                   Exit Function
          End If
          lBufferLen = GetFileVersionInfoSize(sFileName, lDummy)
          If lBufferLen < 1 Then
                  Exit Function
          End If
          ReDim sBuffer(lBufferLen)
          nRet = GetFileVersionInfo(sFileName, _
                0&, _
                lBufferLen, _
                sBuffer(0))
          If nRet = 0 Then
                  Exit Function
          End If
          nRet = VerQueryValue(sBuffer(0), _
                "\VarFileInfo\Translation", _
                lVerPointer, _
                lBufferLen)
          If nRet = 0 Then
                  Exit Function
          End If
          MoveMemory bytBuffer(0), lVerPointer, lBufferLen
          lHexNumber = bytBuffer(2) + bytBuffer(3) * &H100 + _
                bytBuffer(0) * &H10000 + bytBuffer(1) * &H1000000
          sLang_Charset_String = Hex$(lHexNumber)
          Do While Len(sLang_Charset_String) < 8
                  sLang_Charset_String = "0" & sLang_Charset_String
          Loop
          Buffer = String$(255, 0)
          sTemp = "\StringFileInfo\" & sLang_Charset_String _
                & "\" & "ProductVersion"
          nRet = VerQueryValue(sBuffer(0), sTemp, _
                lVerPointer, lBufferLen)
          If nRet = 0 Then
                  Buffer = "N/A"
          Else
                  lstrcpy Buffer, lVerPointer
                  Buffer = Mid$(Buffer, 1, InStr(Buffer, Chr$(0)) - 1)
          End If
          sGetProductProperty = Buffer
  End Function

  Sub test()
    Dim appName As String
    appName = Application.Path & "\Excel.exe"
    MsgBox "Excel当前版本号是：" & sGetProductProperty(appName, FileVersion)
  End Sub

逝去的瞬间

谢谢你tianying，这种方法我想过，我刚才试了一下，我机器上是11.6568，但用种方法得到的是11.0.6560.所以我觉得应该不是使用这种办法。
或者可以这样说，我想知道excel 有没有打过sp补丁，补丁是多少。
在注册表里面找吗？

逝去的瞬间

谢谢你tianying，这种方法我想过，我刚才试了一下，我机器上是11.6568，但用种方法得到的是11.0.6560.所以我觉得应该不是使用这种办法。
或者可以这样说，我想知道excel 有没有打过sp补丁，补丁是多少。
在注册表里面找吗？

逝去的瞬间

哦，我找到了http://support.microsoft.com/kb/821549
HKEY_Local_machine->software->microsoft->office->excel->11.0->Common->productversion->lastproduct
通过注册表来得到。

[此贴子已经被作者于2008-1-28 16:27:10编辑过]

tianying

这个跟Excel关于中的版本信息也不一致吧

tianying

'Microsoft Office 产品对版本号使用下面的语法：
'aa.bbbb.cccc
'此数字代表下列三个项目:
'aa: Office 的版本
'bbbb：程序的可执行文件的版本。例如 Excel.exe 文件。
'cccc: Mso.dll 文件的版本
'知道这层意思就可以很容易获得Excel的版本了:

Private Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersion As Long
    dwFileVersionMSl As Integer
    dwFileVersionMSh As Integer
    dwFileVersionLSl As Integer
    dwFileVersionLSh As Integer
    dwProductVersionMSl As Integer
    dwProductVersionMSh As Integer
    dwProductVersionLSl As Integer
    dwProductVersionLSh As Integer
    dwFileFlagsMask As Long
    dwFileFlags As Long
    dwFileOS As Long
    dwFileType As Long
    dwFileSubtype As Long
    dwFileDateMS As Long
    dwFileDateLS As Long
End Type

Private Declare Function GetFileVersionInfo _
    Lib "Version.dll" Alias _
    "GetFileVersionInfoA" (ByVal lptstrFilename _
    As String, ByVal dwHandle As Long, ByVal _
    dwLen As Long, lpData As Any) As Long

Private Declare Function _
    GetFileVersionInfoSize Lib "Version.dll" _
    Alias "GetFileVersionInfoSizeA" (ByVal _
    lptstrFilename As String, lpdwHandle As _
    Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (dest As Any, src As _
    Long, ByVal length As Long)

Private Declare Function VerQueryValue Lib _
    "Version.dll" Alias "VerQueryValueA" _
    (pBlock As Any, ByVal lpSubBlock As String, _
    lplpBuffer As Any, puLen As Long) As Long

Public Function GetVersionInfo(ByVal sFile As _
    String) As String

    Dim lDummy As Long
    Dim sBuffer() As Byte
    Dim lBufferLen As Long, lVerPointer As Long
    Dim lVerBufferLen As Long
    Dim udtVerBuffer As VS_FIXEDFILEINFO
   
    GetVersionInfo = "N/A"
   
    lBufferLen = GetFileVersionInfoSize(sFile, _
    lDummy)
   
    If lBufferLen > 0 Then
       
        ReDim sBuffer(lBufferLen)
       
        If GetFileVersionInfo(sFile, 0&, _
            lBufferLen, sBuffer(0)) <> 0 Then
           
            If VerQueryValue(sBuffer(0), _
                "\", lVerPointer, lVerBufferLen) _
                <> 0 Then
       
                CopyMemory udtVerBuffer, ByVal _
                    lVerPointer, Len(udtVerBuffer)
                   
                With udtVerBuffer
                    GetVersionInfo = .dwFileVersionLSh
                End With
       
            End If
        End If
    End If

End Function

Sub Excelversion() '获得Excel的详细版本号
    Dim ExcelName As String, MsoName As String
    ExcelName = Application.Path & "\Excel.exe"
    MsoName = "C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.Dll"
    MsgBox "Excel版本号是" & VBA.Val(Application.Version) & "." & _
                 GetVersionInfo(ExcelName) & "." & _
                GetVersionInfo(MsoName)
End Sub

'其它Office产品以此类推

测试结果：我的Excel版本号是11.5612.5606

关于Excel 的截屏

[此贴子已经被作者于2008-1-28 17:40:28编辑过]

逝去的瞬间

tianying兄弟的回答真精彩啊，谢谢了，你说的是对的。
在注册表里面找的应该是office的版本号。