Для наглядности показываю принтскрин:
Как видите, после первой гиперссылки все идет наперекосяк - метит все подряд...
почему так происходит, и как сие побороть?
Код:
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