Van access naar word middels sjablonen o.i.d.

[madref]

Ik ben bezig om gegevens van Access naar Word te exporteren.

Ik maak hierbij gebruik van een sjabloon waarbij ik zoek naar steekwoorden tussen gebroken haakjes "[Woord]".
Op i-net heb ik de volgende funktie gevonden die dit voor mij doet, maar deze werkt prima et strings. Helaas gebruik ik memo-velden.

Wie-o-wie kan ij helpen onderstaande funktie te veranderen zodat deze ook werkt met mem o-velden.

'------------------------------------------------------------------------------------------
' Export2Word
'
' Exporteerd de gegevens in query [BronNaam] naar een bestand dat gebaseerd is
' op het sjabloon [SJabloonNaam] en zet deze in de directory [ExportMap].
'------------------------------------------------------------------------------------------
Function Export2Word(BronNaam As String, SjabloonNaam As String, ExportMap As String) As Boolean

Dim Rc As DAO.Recordset
Dim Fld As DAO.Field

Dim Wrd As Object
Dim WrdDoc As Object
Dim MyRange As Object

Dim WordWasOpen As Boolean
Dim ShowProgress As Boolean
Dim FieldCounter As Long
Dim ExportDocumentNaamVeld As String
Dim ExportDocumentNaam As String
Dim Tag As String
Dim ListString As String

'Sjabloon is niet aanwezig
If Len(Dir(SjabloonNaam)) = 0 Then Exit Function

ExportMap = ValidatePath(ExportMap)
'Exportmap is niet aanwezig
If Len(ExportMap) = 0 Then Exit Function

On Error GoTo WordNotOpen
WordWasOpen = True
Set Wrd = GetObject(, "Word.Application")
On Error GoTo 0

Set Rc = CurrentDb.OpenRecordset(BronNaam, dbOpenDynaset, dbReadOnly)
If Not Rc.EOF Then
    
    'Zoek of er een veld Document naam is op vrij losse overeenkomst
    For Each Fld In Rc.Fields
        If InStr(1, UCase(Fld.Name), "DOCUMENTNAAM") Then
            ExportDocumentNaamVeld = Fld.Name
            Exit For
        End If
    Next
    'Er is geen veld documentnaam gevonden zodoende kan er geen export plaats vinden.
    If Len(ExportDocumentNaamVeld) = 0 Then Exit Function

    Set WrdDoc = Wrd.Documents.Open(SjabloonNaam)
    Rc.MoveFirst
    Do While Not Rc.EOF
        ExportDocumentNaam = Rc.Fields(ExportDocumentNaamVeld)
        ExportDocumentNaam = CleanFileName(ExportDocumentNaam)
        WrdDoc.SaveAs (ExportMap & ExportDocumentNaam)
        Set MyRange = WrdDoc.Content
        'Doorloop alle velden
        For FieldCounter = 0 To Rc.Fields.Count - 1
            Tag = "[" & UCase(Rc.Fields(FieldCounter).Name) & "]"
            If UCase(Mid$(Tag, 2, 3)) = "LST" Then
                ListString = ""
                'Samenstellen lijst
                Do While Rc.Fields(ExportDocumentNaamVeld).Value = ExportDocumentNaam
                    ListString = ListString & Rc.Fields(FieldCounter) & vbCr
                    Rc.MoveNext
                    'controle einde recordset
                    If Rc.EOF Then
                        Exit Do
                    End If
                Loop
                MyRange.Find.Execute Tag, True, True, False, False, False, , 1, , ListString, 2
                Rc.MovePrevious
            Else
                'Tag vervangen door veldwaarde

[B][COLOR="Red"]--==>> Hier gaat het fout :( [/COLOR][/B]
                MyRange.Find.Execute Tag, True, True, False, False, False, , 1, , Rc.Fields(FieldCounter).Value, 2
            End If
        Next
        Rc.MoveNext
        WrdDoc.Save
        WrdDoc.Close False
        Set WrdDoc = Wrd.Documents.Open(SjabloonNaam)
    Loop
End If

WrdDoc.Close False
If Not WordWasOpen Then Wrd.Quit False
Rc.Close
Set Rc = Nothing
Set Wrd = Nothing
Exit Function
WordNotOpen:
WordWasOpen = False
Set Wrd = CreateObject("Word.Application")
Resume Next
End Function

 

[Guus2005]

Bij mij gaat hij goed. Teninste hij loopt zonder problemen door die regel heen.
Wat moet deze regel eigenlijk doen?

MyRange.Find.Execute Tag, True, True, False, False, False, , 1, , Rc.Fields(FieldCounter).Value, 2

 

[madref]

Probeer het eens met een memoveld dat eer dan 255 karakters heeft.

Deze regel vervangt de TAG met de inhoud van Rc.Fields(FieldCounter).Value