Dear All,

Function to compose a new Word.doc from Access-data.
From some records a pich the content of a memofield, from others i insert
the content of a file.
I supose there somthing wrong with the selection-object.
I'm a novice in word-vba.

Thanks

Public Function MakeNewDoc(ByVal iDocID As Long, ByVal strDocName As String)
As Boolean

On Error GoTo ErrHandling

   Dim wordApp As Word.Application
   Dim wordDoc As Word.Document
   Dim WordSel As Word.Selection
   Dim rs As ADODB.Recordset

   DoCmd.Hourglass True

   Set wordApp = CreateObject("Word.Application")
   MakeNewDoc = False

      wordApp.Visible = True
      wordApp.WindowState = wdWindowStateMaximize
      wordApp.Documents.Add
      Set WordSel = Selection
       Set rs = New ADODB.Recordset
       rs.Open "SELECT TBL_TEKSTBLOK_DOCUMENT_MAP.TBDOCM_VOLG_NR,
TBL_TEKST_BLOK.TB_TEKST, TBL_TEKST_BLOK.TB_USE_FILE,
TBL_TEKST_BLOK.TB_FILE_FULL_PATH FROM TBL_TEKST_BLOK INNER JOIN
TBL_TEKSTBLOK_DOCUMENT_MAP ON TBL_TEKST_BLOK.TB_ID =
TBL_TEKSTBLOK_DOCUMENT_MAP.TBDOCM_TB_ID WHERE
(((TBL_TEKSTBLOK_DOCUMENT_MAP.TBDOCM_DOC_ID) = " & iDocID & ")) ORDER BY
TBL_TEKSTBLOK_DOCUMENT_MAP.TBDOCM_VOLG_NR;", CurrentProject.Connection,
adOpenForwardOnly, adLockOptimistic, adCmdText
       With WordSel
            .Font.Size = 12
            .TypeText strDocName & " (" & Environ("username") & ")" &
vbCrLf
            .TypeText "--------------------------------------------------"
& vbCrLf & vbCrLf

            Do Until rs.EOF
                If rs.Fields("TB_USE_FILE") Then 'Add the content of a file
                   .InsertFile rs.Fields("TB_FILE_FULL_PATH"), "", False,
False, False
                Else 'Add the content of a memo-field
                   .InsertAfter rs.Fields("TB_TEKST")
                End If
               .TypeText vbCrLf & vbCrLf
             rs.MoveNext
           Loop
       End With
      wordApp.ActiveDocument.SaveAs CurrentProject.Path & "\" & strDocName
& ".Doc"
      wordApp.Quit

   Set WordSel = Nothing
   Set wordDoc = Nothing
   Set wordApp = Nothing

   MakeNewDoc = True
   DoCmd.Hourglass False

Exit Function

ErrHandling:

   DoCmd.Hourglass False
   MsgBox "Error in function MakeNewDoc" & vbCrLf & vbCrLf & Err.Number & "
" & Err.Description

End Function