Hi guys. Just after a bit of help.
I have a userform to populate a large user manaual (100 odd pages, 5mb) with about 20 custom properties.
All works, but im finding its taking quite a long time to cycle through all the custom properties. Its a selection of code that I have cobbled together so Im sure its very messy and not at all optimised.
The reading of custom properties into the user form takes especially long.
Can anyone point me in the right direction?
'''READ VARIABLES TO FILE PROPERTIES (ON LOAD)
Private Sub UserForm_Initialize()
Dim PropVal As String
MsgBox "Reading document properties. Please be patient", , "O&M Manual creation"
PropVal = ReadProp("Subject")
Subject = ReadProp("Subject")
PropVal = ReadProp("Date Completed")
DateComplete = ReadProp("Date Completed")
PropVal = ReadProp("Company")
Company = ReadProp("Company")
PropVal = ReadProp("NoOfStages")
NoOfStages = ReadProp("NoOfStages")
PropVal = ReadProp("Stage1Process")
Stage1Process = ReadProp("Stage1Process")
PropVal = ReadProp("TrackSpeed")
TrackSpeed = ReadProp("TrackSpeed")
PropVal = ReadProp("Temperature_Controller_Type")
Temperature_Controller_Type = ReadProp("Temperature_Controller_Type")
PropVal = ReadProp("Temperature_Indicator")
Temperature_Indicator = ReadProp("Temperature_Indicator")
PropVal = ReadProp("Product_Height")
Product_Height = ReadProp("Product_Height")
PropVal = ReadProp("Product_Width")
Product_Width = ReadProp("Product_Width")
PropVal = ReadProp("Product_Length")
Product_Length = ReadProp("Product_Length")
PropVal = ReadProp("Customer_Address1")
Customer_Address1 = ReadProp("Customer_Address1")
PropVal = ReadProp("Customer_Address2")
Customer_Address2 = ReadProp("Customer_Address2")
PropVal = ReadProp("Customer_Address3")
Customer_Address3 = ReadProp("Customer_Address3")
PropVal = ReadProp("Customer_Address4")
Customer_Address4 = ReadProp("Customer_Address4")
PropVal = ReadProp("Customer_Address5")
Customer_Address5 = ReadProp("Customer_Address5")
PropVal = ReadProp("Customer_Address6")
Customer_Address6 = ReadProp("Customer_Address6")
'''WRITE VARIABLES TO FILE PROPERTIES
Private Sub OK_Click()
Dim PlantList As String
'Changes document properties to values of userform. Values are linked in documents and will update automatically
' FOUND HERE: https://wordmvp.com/FAQs/MacrosVBA/MixedDocProps.htm
Call WriteProp(sPropName:="Subject", sValue:=Subject)
Call WriteProp(sPropName:="Company", sValue:=Company)
Call WriteProp(sPropName:="Date completed", sValue:=DateComplete)
Call WriteProp(sPropName:="NoOfStages", sValue:=NoOfStages)
Call WriteProp(sPropName:="Stage1Process", sValue:=Stage1Process)
Call WriteProp(sPropName:="TrackSpeed", sValue:=TrackSpeed)
Call WriteProp(sPropName:="Temperature_Controller_Type", sValue:=Temperature_Controller_Type)
Call WriteProp(sPropName:="Temperature_Indicator", sValue:=Temperature_Indicator)
Call WriteProp(sPropName:="Product_Height", sValue:=Product_Height)
Call WriteProp(sPropName:="Product_Width", sValue:=Product_Width)
Call WriteProp(sPropName:="Product_Length", sValue:=Product_Length)
Call WriteProp(sPropName:="Customer Address1", sValue:=Customer_Address1)
Call WriteProp(sPropName:="Customer Address2", sValue:=Customer_Address2)
Call WriteProp(sPropName:="Customer Address3", sValue:=Customer_Address3)
Call WriteProp(sPropName:="Customer Address4", sValue:=Customer_Address4)
Call WriteProp(sPropName:="Customer Address5", sValue:=Customer_Address5)
Call WriteProp(sPropName:="Customer Address6", sValue:=Customer_Address6)
ActiveDocument.Fields.Update
Unload DocProperties
End Sub
Public Sub WriteProp(sPropName As String, sValue As String, _
Optional lType As Long = msoPropertyTypeString)
'In the above declaration, "Optional lType As Long = msoPropertyTypeString" means
'that if the Document Property's Type is Text, we don't need to include the lType argument
'when we call the procedure; but if it's any other Prpperty Type (e.g. date) then we do
Dim bCustom As Boolean
On Error GoTo ErrHandlerWriteProp
'Try to write the value sValue to the custom documentproperties
'If the customdocumentproperty does not exists, an error will occur
'and the code in the errorhandler will run
ActiveDocument.BuiltInDocumentProperties(sPropName).Value = sValue
'Quit this routine
Exit Sub
Proceed:
'We know now that the property is not a builtin documentproperty,
'but a custom documentproperty, so bCustom = True
bCustom = True
Custom:
'Try to set the value for the customproperty sPropName to sValue
'An error will occur if the documentproperty doesn't exist yet
'and the code in the errorhandler will take over
ActiveDocument.CustomDocumentProperties(sPropName).Value = sValue
Exit Sub
AddProp:
'We came here from the errorhandler, so know we know that
'property sPropName is not a built-in property and that there's
'no custom property with this name
'Add it
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add Name:=sPropName, _
LinkToContent:=False, Type:=lType, Value:=sValue
If Err Then
'If we still get an error, the value isn't valid for the Property Type
'e,g an invalid date was used
Debug.Print "The Property " & Chr(34) & _
sPropName & Chr(34) & " couldn't be written, because " & _
Chr(34) & sValue & Chr(34) & _
" is not a valid value for the property type"
End If
Exit Sub
ErrHandlerWriteProp:
Select Case Err
Case Else
'Clear the error
Err.Clear
'bCustom is a boolean variable, if the code jumps to this
'errorhandler for the first time, the value for bCustom is False
If Not bCustom Then
'Continue with the code after the label Proceed
Resume Proceed
Else
'The errorhandler was executed before because the value for
'the variable bCustom is True, therefor we know that the
'customdocumentproperty did not exist yet, jump to AddProp,
'where the property will be made
Resume AddProp
End If
End Select
End Sub
''''READING DOCUMENT PROPERTIES
Function ReadProp(sPropName As String) As Variant
Dim bCustom As Boolean
Dim sValue As String
On Error GoTo ErrHandlerReadProp
'Try the built-in properties first
'An error will occur if the property doesn't exist
sValue = ActiveDocument.BuiltInDocumentProperties(sPropName).Value
ReadProp = sValue
Exit Function
ContinueCustom:
bCustom = True
Custom:
sValue = ActiveDocument.CustomDocumentProperties(sPropName).Value
ReadProp = sValue
Exit Function
ErrHandlerReadProp:
Err.Clear
'The boolean bCustom has the value False, if this is the first
'time that the errorhandler is runned
If Not bCustom Then
'Continue to see if the property is a custom documentproperty
Resume ContinueCustom
Else
'The property wasn't found, return an empty string
ReadProp = ""
Exit Function
End If
End Function