Word Import Export Custom Properties list

SubExportcustom ()"'Exportcustom Macro'Export Custom properties to Custom.txt'    DimLfilenumber as Long    DimSfilepath as String    DimCurrent as Object    SetCurrent =ActiveDocument Sfilepath= Current. Path +"\custom.txt"Lfilenumber=FreeFile() Open Sfilepath forOutput as#lFileNumberDimI as Integer     for  eachObjpropinchCurrent . CustomDocumentPropertiesDimBregular as BooleanBregular=True        IfObjprop.name ="proprietarydeclaration"  ThenBregular=False        End If        IfObjprop.name ="Slevel"  ThenBregular=False        End If        IfObjprop.name ="Slevelui"  ThenBregular=False        End If        IfObjprop.name ="Sflag"  ThenBregular=False        End If        IfBregular Then            Print#lFileNumber, Objprop.name & VbTab &Objprop.valueEnd If    NextClose #lFileNumberMsgBox "Export Complete! "End SubSubUpdatecustom ()"'Updatecustom Macro"'    DimStrupdatecontent as String    DimStrnotfoundproperty as String        DimCurrent as Object    SetCurrent =ActiveDocumentDimLfilenumber as LongLfilenumber=FreeFile() Open current. Path+"\custom.txt"  for Input  as#lFileNumber'Open the file.     DimTextLine as String    DimTmpobj as Object    DimItabindex as Integer     Do  while  not EOF(Lfilenumber)'loops to the end of the file. LineInput#lFileNumber, TextLine'reads a row of data and assigns it to a variable.                 If  not(TextLine ="") ThenItabindex=InStr(TextLine, VbTab)If  not(Itabindex =0 OrItabindex =1 OrItabindex =Len(TextLine)) Then                                DimStrName as String                Dimstrvalue as StringStrName=Mid(TextLine,1, Itabindex-1) Debug.Print StrName'displays the data in the Debug window. strvalue =Mid(TextLine, Itabindex +1) Debug.Print strvalue'displays the data in the Debug window.                                  on Error Resume Next                SetTmpobj = Nothing                SetTmpobj =Current . CustomDocumentProperties (StrName) on Error GoTo 0                If  not(Tmpobj is  Nothing) Then                    If(Tmpobj.type = msopropertytypestring and( not(Tmpobj.value = strvalue))) Thenstrupdatecontent= strupdatecontent & vbCrLf & tmpobj.name & VbTab & Tmpobj.value &"==>>"&strvalue Tmpobj.value=strvalueEnd If                ElseStrnotfoundproperty= Strnotfoundproperty & VbCrLf &StrNameEnd If            End If                End If            Loop    DimStrMsg as String    If  not(Strupdatecontent ="") ThenSTRMSG= STRMSG &"Update Content:"&strupdatecontentEnd If        If  not(Strnotfoundproperty ="") ThenSTRMSG= STRMSG &"Not found property:"&StrnotfoundpropertyEnd If        If(STRMSG ="") ThenSTRMSG="No Update"    End If        MsgBoxSTRMSGEnd SubSubSortcustom ()"'Sortcustom Macro"'    DimCurrent as Object    SetCurrent =ActiveDocument Sfilepath= Current. Path +"\custom.txt"    DimPropertys () as Object    'Set propertys = current. CustomDocumentProperties    DimIproplen as IntegerIproplen=Current . Customdocumentproperties.countDimI as Integer    DimItmpproplen as IntegerItmpproplen=IproplenDimBflag as BooleanBflag=True     Do  whileBflag andItmpproplen >1Bflag=False         fori =1  to(Itmpproplen-1)            IfCurrent. CustomDocumentProperties (i). Name > Current. CustomDocumentProperties (i +1). Name ThenBflag=True                                DimTmpProp1 as Object                SetTMPPROP1 =Current . CustomDocumentProperties (i)DimTmpProp2 as Object                SetTMPPROP2 = Current. CustomDocumentProperties (i +1)                                DimTmppropname as String                DimTmpproptype as Integer                DimTmpproplinktocontent as Boolean                DimTmppropvalue as StringTmppropname=tmpprop1.name Tmpproptype=Tmpprop1.type tmpproplinktocontent=tmpprop1.linktocontent Tmppropvalue=Tmpprop1.value Tmpprop1.name="tmp"Tmpprop1.type=msopropertytypestring tmpprop1.linktocontent=FalseTmpprop1.value="tmp"                                DimTmpPropName2 as String                DimTmpPropType2 as Integer                DimTmpPropLinkToContent2 as Boolean                DimTmpPropValue2 as StringtmpPropName2=tmpprop2.name tmpPropType2=Tmpprop2.type TmpPropLinkToContent2=tmpprop2.linktocontent tmpPropValue2=Tmpprop2.value Tmpprop2.name=tmppropname Tmpprop2.type=Tmpproptype tmpprop2.linktocontent=tmpproplinktocontent Tmpprop2.value=Tmppropvalue Tmpprop1.name=tmpPropName2 Tmpprop1.type=tmpPropType2 tmpprop1.linktocontent=TmpPropLinkToContent2 Tmpprop1.value=tmpPropValue2End If        NextItmpproplen= Itmpproplen-1    Loop            MsgBox "sort of finished! "End Sub

Word Import Export Custom Properties list