[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Word Automation problem from access

Posted on 2012-08-17
7
Medium Priority
?
981 Views
Last Modified: 2012-08-20
dear experts,

i have written some word automation from access
Yet i have a problem. This code works fine when i call it the first time like
Call WriteProp(sPropName:="Adres", sValue:=Nz(rst(6)))
but when i use the function for the second time it returns an empty document. I think it's because the property then already exists. does someone knows how i can fix this so that when i call it again it does work again?


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
  Word.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

Open in new window


Thanks in advance

Mark vrenken
0
Comment
Question by:MarkVrenken
  • 5
  • 2
7 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 38307234
I presume when you talk of first time and second time you are talking in reard to when the error handler is triggered for the first time and when the error handler is triggered a second time?

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 38307244
Not able to test at the moment but ...

Assuming this is so then I suspect the issue is the use of the variable.  What I do is to check for the variable and then I can address the error create locally hence the type error is called just the once.

i.e. ..

bolTest = CustomPropExist(activedocument, sPropName) then
if not boltest then
    on error resume next
    ' Create it ...
    Word.ActiveDocument.CustomDocumentProperties.Add Name:=sPropName, _
        LinkToContent:=False, Type:=lType, value:=sValue
    if err ...
    end if
    on error goto 0


Function CustomPropExist(Doc As Document, strPropName As String) As Boolean
Dim prop As DocumentProperty

    For Each prop In Doc.CustomDocumentProperties
        If LCase(prop.Name) = LCase(strPropName) Then
            CustomPropExist = True
            Exit For
        End If
    Next

End Function

Open in new window


Chris
0
 
LVL 1

Author Comment

by:MarkVrenken
ID: 38307292
Hi Chris, thanks for your reply. I'm sorry for the bad explanation. It's actually the first generated letter that works fine. But when i generate the second letter it doesnt fill in the values of the document properties.
0
What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 38307374
hmm

I have been thinking on the subject to allow for your error handling over types.  I have an idea of how to do it but I need to relocate to a windows pc so will try later ... irrespective of whether someone gives you a solution earlier.  The challenge interests me ... Small minds etc!

Chris
0
 
LVL 59

Assisted Solution

by:Chris Bottomley
Chris Bottomley earned 2000 total points
ID: 38309981
I have played a bit and have produced some code to add the properties in what I think is a little more controlled way ... No offence, I don't like error handling as the primary test method.

Place the following code in a normal model in access:

Option Explicit
Enum enumDocProps
    dpExists
    dpWriteExisting
    dpWrite4Sure
    dpRead
    dpDelete
End Enum

Type typeDocProps
    doc As Object
    strDocPropName As String
    strDocPropNew As String
    strDocPropOrig As Variant
    enudocprop As enumDocProps
    preExists As Boolean
    type As MsoDocProperties
End Type



Function funTestDocProp(testProp As typeDocProps) As typeDocProps
'strDocPropName As String, strDocPropOrig As String, strDocPropNew As String, enudocprop As enumDocProps)
Dim bolExists As Boolean
Dim strOrig As String
Dim prop As Variant
Dim docProp As Variant
Dim cpyTestProp As typeDocProps

    cpyTestProp.preExists = False
    For Each prop In testProp.doc.CustomDocumentProperties
        If LCase(prop.Name) = LCase(testProp.strDocPropName) Then
            bolExists = True
            cpyTestProp.strDocPropOrig = prop.Value
            cpyTestProp.preExists = True
            Set docProp = prop
            Exit For
        End If
    Next
    Select Case testProp.enudocprop
        Case enumDocProps.dpExists
        Case enumDocProps.dpRead
            If bolExists Then
                cpyTestProp.strDocPropOrig = strOrig
            End If
        Case enumDocProps.dpWrite4Sure
            If Not bolExists Then
                'ADD IT FIRST!
                If testProp.type = msoPropertyTypeString And CStr(testProp.strDocPropNew) = testProp.strDocPropNew Then
                    testProp.doc.CustomDocumentProperties.Add Name:=testProp.strDocPropName, _
                        LinkToContent:=False, type:=msoPropertyTypeString, Value:=testProp.strDocPropNew
                ElseIf testProp.type = msoPropertyTypeDate And IsDate(testProp.strDocPropNew) Then
                    testProp.doc.CustomDocumentProperties.Add Name:=testProp.strDocPropName, _
                        LinkToContent:=False, type:=msoPropertyTypeDate, Value:=testProp.strDocPropNew
                ElseIf testProp.type = msoPropertyTypeNumber And IsNumeric(testProp.strDocPropNew) Then
                    testProp.doc.CustomDocumentProperties.Add Name:=testProp.strDocPropName, _
                        LinkToContent:=False, type:=msoPropertyTypeNumber, Value:=testProp.strDocPropNew
                ElseIf testProp.type = msoPropertyTypeFloat And IsNumeric(testProp.strDocPropNew) Then
                    testProp.doc.CustomDocumentProperties.Add Name:=testProp.strDocPropName, _
                        LinkToContent:=False, type:=msoPropertyTypeFloat, Value:=testProp.strDocPropNew
                ElseIf testProp.type = msoPropertyTypeBoolean And IsNumeric(testProp.strDocPropNew) Then
                    testProp.doc.CustomDocumentProperties.Add Name:=testProp.strDocPropName, _
                        LinkToContent:=False, type:=msoPropertyTypeBoolean, Value:=testProp.strDocPropNew
                End If
            End If
            With testProp.doc.CustomDocumentProperties(testProp.strDocPropName)
                .Value = testProp.strDocPropNew
            End With
        Case enumDocProps.dpWriteExisting
            If bolExists Then
                With testProp.doc.CustomDocumentProperties(testProp.strDocPropName)
                    If docProp.type = msoPropertyTypeString And CStr(testProp.strDocPropNew) = testProp.strDocPropNew Then
                        .Value = testProp.strDocPropNew
                    ElseIf .type = msoPropertyTypeDate And IsDate(testProp.strDocPropNew) Then
                        docProp.Value = testProp.strDocPropNew
                    ElseIf .type = msoPropertyTypeNumber And IsNumeric(testProp.strDocPropNew) Then
                        docProp.Value = testProp.strDocPropNew
                    ElseIf .type = msoPropertyTypeFloat And IsNumeric(testProp.strDocPropNew) Then
                        docProp.Value = testProp.strDocPropNew
                    ElseIf .type = msoPropertyTypeBoolean And IsNumeric(testProp.strDocPropNew) Then
                        If testProp.strDocPropNew = CInt(True) Or testProp.strDocPropNew = CInt(False) Then
                            docProp.Value = testProp.strDocPropNew
                        End If
                    Else
                    End If
                End With
            End If
        Case enumDocProps.dpDelete
            If bolExists Then
                testProp.doc.CustomDocumentProperties(testProp.strDocPropName).Delete
            End If
        Case Else
    End Select
    funTestDocProp = cpyTestProp
End Function

Open in new window


I tested this in part using the following script ... for info

Sub testDocProps()
Dim str As String
Dim bol As Boolean
Dim testProp As typeDocProps
Dim varResponse As typeDocProps

'    With testProp
'        Set .doc = ThisDocument
'        .strDocPropName = "fred"
'        .strDocPropNew = "Fred Initialisation"
'        .enudocprop = enumDocProps.dpExists
'    End With
'
'    varResponse = funTestDocProp(testProp)
'
'    MsgBox "Missing property fred exists? ... " & varResponse.preExists
'    testProp.enudocprop = dpRead
'    MsgBox "Missing property fred Value? ... " & funTestDocProp(testProp).strDocPropOrig
'-----------------
'    With testProp
'        Set .doc = ThisDocument
'        .strDocPropName = "doris"
'        .strDocPropNew = "Doris Initialisation"
'        .enudocprop = enumDocProps.dpRead
'    End With
'
'    varResponse = funTestDocProp(testProp)
    
'    MsgBox "Property doris exists? ... " & varResponse.preExists
'    testProp.enudocprop = dpRead
'    MsgBox "Property doris value? ... " & funTestDocProp(testProp).strDocPropOrig
'-----------------
'    str = "Hello World ... timed at " & Time()
'    With testProp
'        Set .doc = ThisDocument
'        .strDocPropName = "doris"
'        .strDocPropNew = "Doris Initialisation"
'        .enudocprop = enumDocProps.dpWriteExisting
'        .strDocPropNew = str
'    End With
'
'    varResponse = funTestDocProp(testProp)
'    testProp.enudocprop = dpRead
'    MsgBox "Existing Property doris updated? ... " & (funTestDocProp(testProp).strDocPropOrig = str)
'-----------------
'-----------------
    str = "Text into a dated field! " & Time()
    With testProp
        Set .doc = ThisDocument
        .strDocPropName = "dated"
        .enudocprop = enumDocProps.dpWriteExisting
        .strDocPropNew = str
    End With

'    varResponse = funTestDocProp(testProp)
'    MsgBox "Existing Property doris updated? ... " & (funTestDocProp(testProp).strDocPropOrig = str)
    str = CDate("21 MAY 1957")
    testProp.strDocPropNew = str
    varResponse = funTestDocProp(testProp)
    MsgBox "Existing Property doris updated? ... " & (funTestDocProp(testProp).strDocPropOrig = str)

End Sub

Sub test2()
Dim str As String
Dim bol As Boolean
Dim testProp As typeDocProps
Dim varResponse As typeDocProps
Dim app As Object
    
    Set app = GetObject(, "Word.application")
    With testProp
        Set .doc = app.documents(1)
        .strDocPropName = "fred"
        .strDocPropNew = "Fred Initialisation"
        .enudocprop = enumDocProps.dpDelete
        .type = msoPropertyTypeString
    End With

' Test 1 delete missing ... call twice to be sure!
    funTestDocProp testProp
    testProp.enudocprop = enumDocProps.dpExists
    If funTestDocProp(testProp).preExists Then MsgBox "Delete error"
    testProp.enudocprop = enumDocProps.dpDelete
    funTestDocProp testProp
    
' Test 2 Add as new
    testProp.enudocprop = enumDocProps.dpWrite4Sure
    If funTestDocProp(testProp).preExists Then MsgBox "Created but didn't pre -exist ... failed test"
    testProp.enudocprop = enumDocProps.dpExists
    If Not funTestDocProp(testProp).preExists Then MsgBox "Test if exists post create ... failed test"

End Sub

Open in new window


In the context of your requirement typified? as

Word.ActiveDocument.CustomDocumentProperties.Add Name:=sPropName, _
    LinkToContent:=False, Type:=lType, value:=sValue

In a copy of your code, try using:

Dim testProp As typeDocProps

    With testProp
        Set .doc = word.activedocument
        .strDocPropName = sPropName
        .strDocPropNew = sValue
        .enudocprop = enumDocProps.dpWrite4Sure ' Create it if not found
        .type = lType
    End With
    funTestDocProp testProp

Open in new window


Longer term the whole thing can be improved I know but for this scope I think it should work fine

Chris
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 38310012
Thought it might be easier to do away with the structure (and found a few bugs !!!) so with defined variables formed each time use the following:

Function funTestDocProp2(doc As Object, strDocPropName As String, strDocPropNew As Variant, ByRef strDocPropOrig As Variant, enudocprop As enumDocProps, ByRef preExists As Boolean, propType As MsoDocProperties) As typeDocProps
'strDocPropName As String, strDocPropOrig As String, strDocPropNew As String, enudocprop As enumDocProps)
Dim bolExists As Boolean
Dim strOrig As String
Dim prop As Variant
Dim docProp As Variant
Dim cpyTestProp As typeDocProps

    preExists = False
    For Each prop In doc.CustomDocumentProperties
        If LCase(prop.Name) = LCase(strDocPropName) Then
            bolExists = True
            strDocPropOrig = prop.Value
            preExists = True
            Set docProp = prop
            Exit For
        End If
    Next
    Select Case enudocprop
        Case enumDocProps.dpExists
        Case enumDocProps.dpRead
            If bolExists Then
                strDocPropOrig = strOrig
            End If
        Case enumDocProps.dpWrite4Sure
            If Not bolExists Then
                'ADD IT FIRST!
                If propType = msoPropertyTypeString And CStr(strDocPropNew) = strDocPropNew Then
                    doc.CustomDocumentProperties.Add Name:=strDocPropName, _
                        LinkToContent:=False, type:=msoPropertyTypeString, Value:=strDocPropNew
                ElseIf propType = msoPropertyTypeDate And IsDate(strDocPropNew) Then
                    doc.CustomDocumentProperties.Add Name:=strDocPropName, _
                        LinkToContent:=False, type:=msoPropertyTypeDate, Value:=strDocPropNew
                ElseIf propType = msoPropertyTypeNumber And IsNumeric(strDocPropNew) Then
                    doc.CustomDocumentProperties.Add Name:=strDocPropName, _
                        LinkToContent:=False, type:=msoPropertyTypeNumber, Value:=strDocPropNew
                ElseIf propType = msoPropertyTypeFloat And IsNumeric(strDocPropNew) Then
                    doc.CustomDocumentProperties.Add Name:=strDocPropName, _
                        LinkToContent:=False, type:=msoPropertyTypeFloat, Value:=strDocPropNew
                ElseIf propType = msoPropertyTypeBoolean And IsNumeric(strDocPropNew) Then
                    doc.CustomDocumentProperties.Add Name:=strDocPropName, _
                        LinkToContent:=False, type:=msoPropertyTypeBoolean, Value:=strDocPropNew
                End If
            End If
            With doc.CustomDocumentProperties(strDocPropName)
                .Value = strDocPropNew
            End With
        Case enumDocProps.dpWriteExisting
            If bolExists Then
                With doc.CustomDocumentProperties(strDocPropName)
                    If propType = msoPropertyTypeString And CStr(strDocPropNew) = strDocPropNew Then
                        docProp.Value = strDocPropNew
                    ElseIf propType = msoPropertyTypeDate And IsDate(strDocPropNew) Then
                        docProp.Value = strDocPropNew
                    ElseIf propType = msoPropertyTypeNumber And IsNumeric(strDocPropNew) Then
                        docProp.Value = strDocPropNew
                    ElseIf propType = msoPropertyTypeFloat And IsNumeric(strDocPropNew) Then
                        docProp.Value = strDocPropNew
                    ElseIf propType = msoPropertyTypeBoolean And IsNumeric(strDocPropNew) Then
                        If strDocPropNew = CInt(True) Or strDocPropNew = CInt(False) Then
                            docProp.Value = strDocPropNew
                        End If
                    Else
                    End If
                End With
            End If
        Case enumDocProps.dpDelete
            If bolExists Then
                doc.CustomDocumentProperties(strDocPropName).Delete
            End If
        Case Else
    End Select

End Function

Open in new window


Tested for string and date as follows:

Sub test3()
Dim TDP_Doc As Object
Dim TDP_PropName As String
Dim TDP_NewValue As String
Dim TDP_OrigValue As String
Dim TDP_Activity As enumDocProps
Dim TDP_PreExists As Boolean
Dim TDP_PropType As MsoDocProperties
Dim app As Object
    
    Set TDP_Doc = GetObject(, "Word.application").documents(1)
    TDP_PropName = "fred"
    TDP_NewValue = "Fred Initialisation"
    TDP_Activity = enumDocProps.dpDelete
    TDP_PropType = msoPropertyTypeString

    funTestDocProp2 TDP_Doc, TDP_PropName, TDP_NewValue, TDP_OrigValue, TDP_Activity, TDP_PreExists, TDP_PropType
    TDP_Activity = enumDocProps.dpWrite4Sure
    funTestDocProp2 TDP_Doc, TDP_PropName, TDP_NewValue, TDP_OrigValue, TDP_Activity, TDP_PreExists, TDP_PropType
    
    TDP_Activity = enumDocProps.dpDelete
'    TDP_PropType = msoPropertyTypeDate

    funTestDocProp2 TDP_Doc, TDP_PropName, TDP_NewValue, TDP_OrigValue, TDP_Activity, TDP_PreExists, TDP_PropType
    TDP_NewValue = Date
    TDP_Activity = enumDocProps.dpWrite4Sure
    funTestDocProp2 TDP_Doc, TDP_PropName, TDP_NewValue, TDP_OrigValue, TDP_Activity, TDP_PreExists, TDP_PropType
    TDP_PropType = msoPropertyTypeDate
    funTestDocProp2 TDP_Doc, TDP_PropName, TDP_NewValue, TDP_OrigValue, TDP_Activity, TDP_PreExists, TDP_PropType

End Sub

Open in new window

0
 
LVL 1

Author Closing Comment

by:MarkVrenken
ID: 38311357
Thank you so much chris. I tested the code and it works. For future reference. I had an error on msoDocProperties because i didnt have microsoft office 14.0 in my references. after i selected it worked! so thanks for your help. People like you are the reason i joined!
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The canonical version of this article is on my web site here: http://iconoun.com/articles/collisions/ A companion presentation is available here: http://iconoun.com/articles/collisions/Unicode_Presentation.pdf
We were having a lot of "Heartbeat Alerts" in our SCOM environment, now "Heartbeat" in a SCOM environment for those of you who might not be familiar with SCOM is a packet of data sent from the agent to the management server on a regular basis, basic…
Viewers will learn how to maximize accessibility options in an Excel workbook for users with accessibility issues.
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…

873 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question