Hi everybody,
I added a VB macro to my Excel files so that the metadata are retrieved in Sharepoint. Though, when I create a new version of my Excel file (the versioning is activated on SP), the macro does not trigger and the metadata are still retrieved from the old
version. In order to get the right metadata, I must open the file and save it again. Does anybody have any idea of what I should do?
Thanx
Hereafter the code of my macro
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Mise à jour Montant
SetCustomProperty "Montant", Application.ActiveWorkbook.Sheets("EA").Range("N12")
SetContentTypeProperty_Double "Montant", Application.ActiveWorkbook.Sheets("EA").Range("N12")
'Mise à jour Acompte
SetCustomProperty "Acompte", Application.ActiveWorkbook.Sheets("EA").Range("N7")
SetContentTypeProperty_Double "Acompte", Application.ActiveWorkbook.Sheets("EA").Range("N7")
'Mise à jour Analytique
SetCustomProperty "Analytique", Application.ActiveWorkbook.Sheets("EA").Range("M4")
SetContentTypeProperty_String "Analytique", Application.ActiveWorkbook.Sheets("EA").Range("M4")
'Mise à jour du NouveauCumul
SetCustomProperty "NouveauCumul", Application.ActiveWorkbook.Sheets("EA").Range("N10")
SetContentTypeProperty_Double "NouveauCumul", Application.ActiveWorkbook.Sheets("EA").Range("N10")
'Mise à jour Garantie
SetCustomProperty "Garantie", Application.ActiveWorkbook.Sheets("EA").Range("G12")
SetContentTypeProperty_String "Garantie", Application.ActiveWorkbook.Sheets("EA").Range("G12")
'Mise à jour Echeance
SetCustomProperty "Echeance", Application.ActiveWorkbook.Sheets("EA").Range("G11")
SetContentTypeProperty_Date "Echeance", Application.ActiveWorkbook.Sheets("EA").Range("G11")
'Mise à jour Début Période
SetCustomProperty "Debut", Application.ActiveWorkbook.Sheets("EA").Range("M8")
SetContentTypeProperty_Date "Debut", Application.ActiveWorkbook.Sheets("EA").Range("M8")
'Mise à jour fin de période
SetCustomProperty "Fin", Application.ActiveWorkbook.Sheets("EA").Range("O8")
SetContentTypeProperty_Date "Fin", Application.ActiveWorkbook.Sheets("EA").Range("O8")
End Sub
Private Sub SetCustomProperty(name As String, value As Variant)
If CheckCustomPropertyType(name) = CheckType(value) Then
Application.ActiveWorkbook.CustomDocumentProperties(name).value = value
Else
DeleteCustomProperty name
Application.ActiveWorkbook.CustomDocumentProperties.Add _
name:=name, _
LinkToContent:=False, _
Type:=CheckType(value), _
value:=value, _
LinkSource:=False
End If
End Sub
Private Sub SetContentTypeProperty_Double(name As String, value As Double)
On Error Resume Next
Application.ActiveWorkbook.ContentTypeProperties(name).value = value
End Sub
Private Sub SetContentTypeProperty_String(name As String, value As String)
On Error Resume Next
Application.ActiveWorkbook.ContentTypeProperties(name).value = value
End Sub
Private Sub SetContentTypeProperty_Date(name As String, value As Date)
On Error Resume Next
Application.ActiveWorkbook.ContentTypeProperties(name).value = value
End Sub
Private Function CheckCustomProperty(name As String)
Dim objDocProp As DocumentProperty
CheckCustomProperty = False
For Each objDocProp In Application.ActiveWorkbook.CustomDocumentProperties
If name = objDocProp.name Then
CheckCustomProperty = True
Exit Function
End If
Next
End Function
Private Function CheckCustomPropertyType(name As String)
If CheckCustomProperty(name) Then
CheckCustomPropertyType = Application.ActiveWorkbook.CustomDocumentProperties(name).Type
Else
CheckCustomPropertyType = -1
End If
End Function
Private Sub DeleteCustomProperty(name As String)
If CheckCustomProperty(name) Then
Application.ActiveWorkbook.CustomDocumentProperties(name).Delete
End If
End Sub
Private Function CheckType(pVar_Val)
Dim lVar_X As Variant
''Extract from the Excel VBA Help file
''vbEmpty 0 Empty (uninitialized)
''vbNull 1 Null (no valid data)
''vbInteger 2 Integer
''vbLong 3 Long integer
''vbSingle 4 Single-precision floating-point number
''vbDouble 5 Double-precision floating-point number
''vbCurrency 6 Currency value
''vbDate 7 Date value
''vbString 8 String
''vbObject 9 Object
''vbError 10 Error value
''vbBoolean 11 Boolean value
''vbVariant 12 Variant (used only with arrays of variants)
''vbDataObject 13 A data access object
''vbDecimal 14 Decimal value
''vbByte 17 Byte value
''vbArray 8192 Array
Select Case VarType(pVar_Val)
Case 0, 1, 8, 10
lVar_X = msoPropertyTypeString
Case 2, 3
lVar_X = msoPropertyTypeNumber
Case 4, 5, 6, 14
lVar_X = msoPropertyTypeFloat
Case 7
lVar_X = msoPropertyTypeDate
Case 11
'' Boolean
lVar_X = msoPropertyTypeBoolean
Case Else ''Bucket
lVar_X = msoPropertyTypeString
End Select
CheckType = lVar_X
End Function
