при экспорте в Word стиль Гиперссылка перебивает все др.

Compositum
Дата: 05.03.2008 21:35:57
Для наглядности показываю принтскрин:
Картинка с другого сайта.
Как видите, после первой гиперссылки все идет наперекосяк - метит все подряд...
почему так происходит, и как сие побороть?
Код:
Option Compare Database
Option Explicit

Public Function ExportToWord(Optional Mychar As String)
Dim db As DAO.Database, qd As DAO.QueryDef, rs As DAO.Recordset
Set db = CurrentDb
Set qd = db.CreateQueryDef("")
If Mychar <> "" Then
qd.SQL = "SELECT tabMembers.company AS ucaseCompany, tabVedType.vedName, ""Почтовый адрес: "" & [adress] " & _
" AS pochtaAdres, tabMembers.telephone, IIf(NZ([fax],"""")<>"""",""Ф. "" & [fax],"""") AS ffax, tabMembers.email, tabMembers.www, " & _
" tabMembers.dopInf, UCase([typeName]) AS ucaseTypeName, [CountUsers] & "" человек."" AS countUserss, tabMembers.God " & _
" FROM tabVedType RIGHT JOIN (tabTypesPay RIGHT JOIN (tabTypeInfo RIGHT JOIN tabMembers ON tabTypeInfo.typeInfoID = " & _
" tabMembers.typeInfoID) ON tabTypesPay.typePayID = tabMembers.typePayID) ON tabVedType.vedID = tabMembers.vedID " & _
" WHERE (((tabMembers.company) Like '" & Mychar & "*')) ORDER BY tabMembers.company;"
'qd.Parameters(0) = Mychar
Else
qd.SQL = "SELECT tabMembers.company AS ucaseCompany, tabVedType.vedName, ""Почтовый адрес: "" & [adress] " & _
" AS pochtaAdres, tabMembers.telephone, IIf(NZ([fax],"""")<>"""",""Ф. "" & [fax],"""") AS ffax, tabMembers.email, tabMembers.www, " & _
" tabMembers.dopInf, UCase([typeName]) AS ucaseTypeName, [CountUsers] & "" человек."" AS countUserss, tabMembers.God " & _
" FROM tabVedType RIGHT JOIN (tabTypesPay RIGHT JOIN (tabTypeInfo RIGHT JOIN tabMembers ON tabTypeInfo.typeInfoID = " & _
" tabMembers.typeInfoID) ON tabTypesPay.typePayID = tabMembers.typePayID) ON tabVedType.vedID = tabMembers.vedID " & _
" ORDER BY tabMembers.company;"
End If
'Debug.Print qd.SQL
Set rs = qd.OpenRecordset(dbOpenDynaset)
If rs.RecordCount = 0 Then GoTo lab1
    Dim appWord As Word.Application
    Set appWord = CreateObject("Word.Application")
    Dim doc As Word.Document
    Set doc = appWord.Documents.Add("c:\template.dot")
    appWord.Visible = True
    rs.MoveFirst
    Do Until rs.EOF
    With appWord
'    .Selection.Style = ActiveDocument.Styles("headline")
'    .Selection.Font.Name = "Times New Roman"
'    .Selection.Font.Size = 16
'    .Selection.Font.Color = wdColorAutomatic
'    .Selection.Font.Color = -587137025
    If Not IsNull(rs!ucaseCompany) Then
    .Selection.TypeParagraph
    .Selection.Style = doc.Styles("headline")
    .Selection.TypeText Text:=rs!ucaseCompany
    End If
    If Not IsNull(rs!dopInf) Then
    .Selection.TypeParagraph
    .Selection.Style = doc.Styles("text_main")
    .Selection.TypeText Text:=rs!dopInf
    End If
    If Not IsNull(rs!God) Then
    .Selection.TypeParagraph
    .Selection.Style = doc.Styles("text_main")
    .Selection.TypeText Text:="Год создания - " & rs!God
    End If
    If Not IsNull(rs!countUserss) Then
    .Selection.TypeParagraph
    .Selection.Style = doc.Styles("text_main")
    .Selection.TypeText Text:="Численность работающих - " & rs!countUserss
    End If
    If Not IsNull(rs!pochtaAdres) Then
    .Selection.TypeParagraph
    .Selection.Style = doc.Styles("text_main")
    .Selection.TypeText Text:=rs!pochtaAdres
    End If
    If Not IsNull(rs!telephone) Then
    .Selection.TypeParagraph
    .Selection.Style = doc.Styles("text_main")
    .Selection.TypeText Text:="Т.: " & rs!telephone
    End If
    If Not IsNull(rs!ffax) Then
    .Selection.TypeParagraph
    .Selection.Style = doc.Styles("text_main")
    .Selection.TypeText Text:=rs!ffax
    End If
    If Not IsNull(rs!Email) Then
    .Selection.TypeParagraph
    .Selection.Style = doc.Styles("text_main")
    .Selection.TypeText Text:="E-mail: "
    .Selection.Style = doc.Styles("Гиперссылка")
    .Selection.TypeText Text:=rs!Email    
    End If
    If Not IsNull(rs!www) Then
    .Selection.TypeParagraph
    .Selection.Style = doc.Styles("Гиперссылка")
    .Selection.TypeText Text:=rs!www    
    End If
    If Not IsNull(rs!vedName) Then
    .Selection.TypeParagraph
    .Selection.Style = doc.Styles("text_main_detailed")
    .Selection.TypeText Text:=rs!vedName
    End If
    End With
    rs.MoveNext
    Loop
'    doc.Close
'    appWord.Quit
    Set doc = Nothing
    Set appWord = Nothing
    
lab1:
   rs.Close
   qd.Close
   db.Close
   Set rs = Nothing
   Set qd = Nothing
   Set db = Nothing
End Function


Compositum
Дата: 05.03.2008 21:48:38
проблема решена. нужно после каждой добавленной ссылки добавлять код сброса формата:
.Selection.ClearFormatting
все работает как часики.