VBA Macros and SmartDocs: Reusable Variables

Follow

One of the things you can use the SmartDocs API for is to work with SmartDocs reusable variables. Using the API you can:

  • Determine whether a document contains any Reusable Variables (HasReusableVariables method), or has a Reusable Variable with a specific name (ContainsReusableVariable method).
  • Retrieve a Reusable Variable of a specific name (GetReusableVariableByName method).
  • Create a new Reusable Variable (CreateReusableVariable method).
  • Insert a Reusable Variable (InsertReusableVariable method).
  • Update a Reusable Variable (UpdateReusableVariable method).

All the above methods are members of the SmartDocsAutomationDocument class.

In addition, you can determine a reusable variable's name, ID, and value, as well as find out whether it allows multiple lines. These properties are members of the SmartDocsAutomationReusableVariable class.

For more information on these methods and properties, please consult the SmartDocs Automation API help file.

The following code sample demonstrates how to

  • determine whether the current document contains any reusable variables,
  • determine whether the current document contains reusable variables with the specified name,
  • update a reusable variables of a specified name with a specified value, and
  • retrieve the name and value of the reusable variable object returned by the update method.

    Read the article titled VBA Macros and SmartDocs: Retrieving a SmartDocs Document for the Get_SmartDoc_Document method used in the sample code.

    Option Explicit
    Private Const cModuleName As String = "basSmartDocs_Document_Sample"
    
    Sub Update_SD_Variable()
        Dim sProcName As String, sSourceName As String
        Dim sVarName As String
        Dim SD_Doc As Object
        Dim wordDoc As Word.Document
        Dim SD_AutomationResult As Object
        Dim hasVariables As Boolean, hasVarNameVariable As Boolean
        Dim updatedVariable As Object
        Dim sVarNewValue As String
        
        On Error GoTo ErrorHandler
        
        sProcName = "Update_SD_Variable"
        sSourceName = cModuleName & "." & sProcName
        sVarName = "Company Name"
        sVarNewValue = "Test 6"
        Set wordDoc = ActiveDocument
        Set SD_Doc = basSmartDocs_Document_Sample.Get_SmartDoc_Document(wordDoc)
        'Make sure we have a SmartDoc Document object to work with
        If SD_Doc Is Nothing Then
            Err.Raise vbObjectError + 1001, sSourceName, _
                "SmartDoc Document could not be initialized."
        End If
        
        'Determine whether the document has any Reusable variables
        Set SD_AutomationResult = SD_Doc.HasReusableVariables
        If Not SD_AutomationResult.Success Then
            Err.Raise vbObjectError + 2001, sSourceName, _
                "It was not possible to determine whether any Reusable Variables " & _
                "are present in the document."
        End If
        hasVariables = SD_AutomationResult.Object
        
        'Determine whether the document has the specific reusable variable
        Set SD_AutomationResult = SD_Doc.ContainsReusableVariable(sVarName)
        If Not SD_AutomationResult.Success Then
            Err.Raise vbObjectError + 2002, sSourceName, _
                "It was not possible to determine whether the specified Reusable Variable " _
                & sVarName & " is present in the document."
        End If
        hasVarNameVariable = SD_AutomationResult.Object
        
        If hasVarNameVariable Then
            'Attempt to update the variable's value with a new value.
            Set SD_AutomationResult = _
                SD_Doc.UpdateReusableVariable(sVarName, "Value", sVarNewValue)
            If Not SD_AutomationResult.Success Then
                Err.Raise vbObjectError + 2003, sSourceName, _
                    "Could not update the Reusable Variable " & sVarName & _
                    " with the value " & sVarNewValue & "."
            End If
            
            'If the update action was successful, then 
            'SD_Automation.Object returns the Reusable Variable object.
            Set updatedVariable = SD_AutomationResult.Object
            If Not updatedVariable Is Nothing Then
                MsgBox "Update was successful!" & vbCr & _
                    "The variable " & updatedVariable.Name & " now has the value " & _
                    updatedVariable.Value, vbOKOnly, _
                    basSmartDocs_Document_Sample.cMsgTitle_SmartDocVBADemo
            Else
                MsgBox "Update was not successful!", vbOKOnly, _
                    basSmartDocs_Document_Sample.cMsgTitle_SmartDocVBADemo
            End If
        End If
        Debug.Print hasVariables, hasVarNameVariable
        Exit Sub
    
    ErrorHandler:
       MsgBox Err.Number & vbCr & Err.Description & vbCr & Err.Source, vbCritical + vbOKOnly, _
          cMsgTitle_SmartDocVBADemo
    
    End Sub
Article modified

Comments

  • Avatar
    36Software

    After installing SmartDocs, you need to activate it in order to gain full access to the SmartDocs features. You activate SmartDocs using the SmartDocs Activation Wizard (SmartDocs ribbon tab > About menu > Activate SmartDocs button).

    You activate SmartDocs using your SmartDocs activation code. Your activation code is a 12-digit number (example: 1344-2760-3692) that was given to you when you began your SmartDocs evaluation or purchased SmartDocs. Once activation is complete, a success message will be displayed and you will have access to the SmartDocs features.

  • Avatar
    36Software

    SmartDocs supports Microsoft Office 2007, Office 2010, and Office 2013 running on Windows XP, Windows Vista, Windows 7, and Windows 8. SmartDocs supports both the 32-bit and 64-bit versions of Windows and Microsoft Office.

  • Avatar
    36Software

    Another comment. SmartDocs supports Microsoft Office 2007, Office 2010, and Office 2013 running on Windows XP, Windows Vista, Windows 7, and Windows 8. SmartDocs supports both the 32-bit and 64-bit versions of Windows and Microsoft Office.

Please sign in to leave a comment.
Powered by Zendesk