Excel Macro does not trigger in Sharepoint RRS feed

  • Question

  • 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?


    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
            DeleteCustomProperty name
            Application.ActiveWorkbook.CustomDocumentProperties.Add _
            name:=name, _
            LinkToContent:=False, _
            Type:=CheckType(value), _
            value:=value, _
        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


    End Function
    Private Function CheckCustomPropertyType(name As String)

        If CheckCustomProperty(name) Then
            CheckCustomPropertyType = Application.ActiveWorkbook.CustomDocumentProperties(name).Type
            CheckCustomPropertyType = -1
        End If

    End Function
    Private Sub DeleteCustomProperty(name As String)

        If CheckCustomProperty(name) Then
        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

    • Edited by FX_2012 Thursday, March 28, 2013 1:10 PM
    Thursday, March 28, 2013 1:08 PM