How do I retrieve entire Revision Number on Excel 2007?

Z

Zoo

I set a xls file's revision number as '1.2.3' by Windows Explorer.
Then the following macro shows '1.2.3' on Excel 2002/2003.
Sub Main
Debug.Print ThisWorkBook.BuiltInDocumentProperties("Revision Number")
End Sub

But the code above shows '1' on Excel 2007.
I want to get '1.2.3' on this case.

So I want to get the DocumentProperty by using of DISPCALLFUNC and
StgOpenStorageEx and ReadMultiple.
How can I do this?

I found the following code on the internet . This code sets the revision
number.
But I want to retrieve the number, not to set.

-----------------------------------------------------------
Private Const PIDSI_REVNUMBER As Long = &H9
Private Const STGFMT_FILE As Long = &H3&
Private Const STGFMT_DOCFILE As Long = &H5&
Private Const CC_STDCALL As Long = &H4&
Private Const STGM_READWRITE As Long = &H2&
Private Const STGM_SHARE_EXCLUSIVE As Long = &H10&
Private Const PROPSETFLAG_ANSI As Long = &H2&
Private Const PRSPEC_PROPID As Long = &H1&
Private Const VT_LPSTR As Long = 30&
Private Const STG_E_FILEALREADYEXISTS As Long = &H80030050

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type PROPSPEC
ulKind As Long
PropId As Long
End Type
Private Type PROPVARIANT
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
pszVal As String
Padding As Long
End Type

Private Declare Sub DispCallFunc Lib "oleaut32" _
(ByVal pvInstance As Long, ByVal oVft As Long, _
ByVal cc As Long, ByVal vtReturn As Integer, _
ByVal cActuals As Long, prgvt As Integer, _
prgpvarg As Long, pvargResult As Variant)
Private Declare Sub IIDFromString Lib "ole32" _
(ByVal lpsz As Long, lpiid As GUID)
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function StgOpenStorageEx Lib "ole32" _
(ByVal pwcsName As Long, ByVal grfMode As Long, _
ByVal stgfmt As Long, ByVal grfAttrs As Long, _
ByVal reserved1 As Long, ByVal reserved2 As Long, _
riid As GUID, ppObjectOpen As IUnknown) As Long

Private Function CallComMethod(unk As IUnknown _
, ByVal VTBLIndex As Long _
, ParamArray Args() As Variant) As Long
Dim pArgs() As Long
Dim vt() As Integer
Dim pvargResult As Variant
Dim c As Long
Dim i As Long
c = UBound(Args) + 1
ReDim pArgs(0 To c + (c > 0))
ReDim vt(0 To UBound(pArgs))
For i = 0 To c - 1
vt(i) = VarType(Args(i))
pArgs(i) = VarPtr(Args(i))
Next
DispCallFunc ObjPtr(unk), VTBLIndex * 4& _
, CC_STDCALL, vbLong, c, vt(0), pArgs(0), pvargResult
CallComMethod = pvargResult
End Function

Private Sub SetFileRevNumber(Path As String, Value As String)
Const IID_IPropertySetStorageString As String _
= "{0000013A-0000-0000-C000-000000000046}"
Const FMTID_SummaryInformationString As String _
= "{F29F85E0-4FF9-1068-AB91-08002B27B3D9}"
Dim IID_IPropertySetStorage As GUID
Dim FMTID_SummaryInformation As GUID
Dim PrpSpec As PROPSPEC
Dim PrpVariant As PROPVARIANT
Dim PropSetStorage As IUnknown
Dim PropStorage As IUnknown
Dim temp As Long
IIDFromString VBA.StrPtr(IID_IPropertySetStorageString) _
, IID_IPropertySetStorage
IIDFromString VBA.StrPtr(FMTID_SummaryInformationString) _
, FMTID_SummaryInformation
If StgOpenStorageEx(VBA.StrPtr(Path) _
, STGM_READWRITE Or STGM_SHARE_EXCLUSIVE _
, STGFMT_DOCFILE, 0&, 0&, 0& _
, IID_IPropertySetStorage, PropSetStorage) _
= STG_E_FILEALREADYEXISTS Then
StgOpenStorageEx VBA.StrPtr(Path) _
, STGM_READWRITE Or STGM_SHARE_EXCLUSIVE _
, STGFMT_FILE, 0&, 0&, 0& _
, IID_IPropertySetStorage, PropSetStorage
End If
If CallComMethod(PropSetStorage, 3& _
, VBA.VarPtr(FMTID_SummaryInformation), 0&, PROPSETFLAG_ANSI _
, STGM_READWRITE Or STGM_SHARE_EXCLUSIVE, temp) _
= STG_E_FILEALREADYEXISTS Then
CallComMethod PropSetStorage, 4& _
, VBA.VarPtr(FMTID_SummaryInformation) _
, STGM_READWRITE Or STGM_SHARE_EXCLUSIVE, temp
End If
MoveMemory PropStorage, temp, 4&
With PrpSpec
.ulKind = PRSPEC_PROPID: .PropId = PIDSI_REVNUMBER
End With
With PrpVariant
.vt = VT_LPSTR: .pszVal = VBA.StrConv(Value, vbFromUnicode)
End With
CallComMethod PropStorage, 4&, 1& _
, VBA.VarPtr(PrpSpec), VBA.VarPtr(PrpVariant), 0&
End Sub

Sub Sample()
SetFileRevNumber "C:\temp\hoge.xls", "1.2.3"
End Sub
 
J

Jim Rech

The problem seems to be that Excel 2007 does not accept a revision number
such as 1.2.3. When I opened an XLSX to which I had added such a revision
number via Explorer, Excel 2007 complained that the file was corrupted and
that it had to make repairs. When I saved this file and looked at its
revision number it was actually changed to 1. So Excel is reporting the
correct revision number in the file, after the repair.

--
Jim
|I set a xls file's revision number as '1.2.3' by Windows Explorer.
| Then the following macro shows '1.2.3' on Excel 2002/2003.
| Sub Main
| Debug.Print ThisWorkBook.BuiltInDocumentProperties("Revision Number")
| End Sub
|
| But the code above shows '1' on Excel 2007.
| I want to get '1.2.3' on this case.
|
| So I want to get the DocumentProperty by using of DISPCALLFUNC and
| StgOpenStorageEx and ReadMultiple.
| How can I do this?
|
| I found the following code on the internet . This code sets the revision
| number.
| But I want to retrieve the number, not to set.
|
| -----------------------------------------------------------
| Private Const PIDSI_REVNUMBER As Long = &H9
| Private Const STGFMT_FILE As Long = &H3&
| Private Const STGFMT_DOCFILE As Long = &H5&
| Private Const CC_STDCALL As Long = &H4&
| Private Const STGM_READWRITE As Long = &H2&
| Private Const STGM_SHARE_EXCLUSIVE As Long = &H10&
| Private Const PROPSETFLAG_ANSI As Long = &H2&
| Private Const PRSPEC_PROPID As Long = &H1&
| Private Const VT_LPSTR As Long = 30&
| Private Const STG_E_FILEALREADYEXISTS As Long = &H80030050
|
| Private Type GUID
| Data1 As Long
| Data2 As Integer
| Data3 As Integer
| Data4(0 To 7) As Byte
| End Type
| Private Type PROPSPEC
| ulKind As Long
| PropId As Long
| End Type
| Private Type PROPVARIANT
| vt As Integer
| wReserved1 As Integer
| wReserved2 As Integer
| wReserved3 As Integer
| pszVal As String
| Padding As Long
| End Type
|
| Private Declare Sub DispCallFunc Lib "oleaut32" _
| (ByVal pvInstance As Long, ByVal oVft As Long, _
| ByVal cc As Long, ByVal vtReturn As Integer, _
| ByVal cActuals As Long, prgvt As Integer, _
| prgpvarg As Long, pvargResult As Variant)
| Private Declare Sub IIDFromString Lib "ole32" _
| (ByVal lpsz As Long, lpiid As GUID)
| Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
| (Destination As Any, Source As Any, ByVal Length As Long)
| Private Declare Function StgOpenStorageEx Lib "ole32" _
| (ByVal pwcsName As Long, ByVal grfMode As Long, _
| ByVal stgfmt As Long, ByVal grfAttrs As Long, _
| ByVal reserved1 As Long, ByVal reserved2 As Long, _
| riid As GUID, ppObjectOpen As IUnknown) As Long
|
| Private Function CallComMethod(unk As IUnknown _
| , ByVal VTBLIndex As Long _
| , ParamArray Args() As Variant) As Long
| Dim pArgs() As Long
| Dim vt() As Integer
| Dim pvargResult As Variant
| Dim c As Long
| Dim i As Long
| c = UBound(Args) + 1
| ReDim pArgs(0 To c + (c > 0))
| ReDim vt(0 To UBound(pArgs))
| For i = 0 To c - 1
| vt(i) = VarType(Args(i))
| pArgs(i) = VarPtr(Args(i))
| Next
| DispCallFunc ObjPtr(unk), VTBLIndex * 4& _
| , CC_STDCALL, vbLong, c, vt(0), pArgs(0), pvargResult
| CallComMethod = pvargResult
| End Function
|
| Private Sub SetFileRevNumber(Path As String, Value As String)
| Const IID_IPropertySetStorageString As String _
| = "{0000013A-0000-0000-C000-000000000046}"
| Const FMTID_SummaryInformationString As String _
| = "{F29F85E0-4FF9-1068-AB91-08002B27B3D9}"
| Dim IID_IPropertySetStorage As GUID
| Dim FMTID_SummaryInformation As GUID
| Dim PrpSpec As PROPSPEC
| Dim PrpVariant As PROPVARIANT
| Dim PropSetStorage As IUnknown
| Dim PropStorage As IUnknown
| Dim temp As Long
| IIDFromString VBA.StrPtr(IID_IPropertySetStorageString) _
| , IID_IPropertySetStorage
| IIDFromString VBA.StrPtr(FMTID_SummaryInformationString) _
| , FMTID_SummaryInformation
| If StgOpenStorageEx(VBA.StrPtr(Path) _
| , STGM_READWRITE Or STGM_SHARE_EXCLUSIVE _
| , STGFMT_DOCFILE, 0&, 0&, 0& _
| , IID_IPropertySetStorage, PropSetStorage) _
| = STG_E_FILEALREADYEXISTS Then
| StgOpenStorageEx VBA.StrPtr(Path) _
| , STGM_READWRITE Or STGM_SHARE_EXCLUSIVE _
| , STGFMT_FILE, 0&, 0&, 0& _
| , IID_IPropertySetStorage, PropSetStorage
| End If
| If CallComMethod(PropSetStorage, 3& _
| , VBA.VarPtr(FMTID_SummaryInformation), 0&, PROPSETFLAG_ANSI _
| , STGM_READWRITE Or STGM_SHARE_EXCLUSIVE, temp) _
| = STG_E_FILEALREADYEXISTS Then
| CallComMethod PropSetStorage, 4& _
| , VBA.VarPtr(FMTID_SummaryInformation) _
| , STGM_READWRITE Or STGM_SHARE_EXCLUSIVE, temp
| End If
| MoveMemory PropStorage, temp, 4&
| With PrpSpec
| .ulKind = PRSPEC_PROPID: .PropId = PIDSI_REVNUMBER
| End With
| With PrpVariant
| .vt = VT_LPSTR: .pszVal = VBA.StrConv(Value, vbFromUnicode)
| End With
| CallComMethod PropStorage, 4&, 1& _
| , VBA.VarPtr(PrpSpec), VBA.VarPtr(PrpVariant), 0&
| End Sub
|
| Sub Sample()
| SetFileRevNumber "C:\temp\hoge.xls", "1.2.3"
| End Sub
|
|
|
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Assign a sound to a variable 19
Excel Application to MS Access Application 2
converting VBA password-masking code to 64-bit 0
Closing programs on remote PC - help please 1
Show/Hide Minimize/Maximize Button in Excel 2007/2010 2
Automatically copy with save? 8
Alarm 2 2
use vba to open pdf then save as xml 6

Top