Разбор гиперссылок из Access VBA в шаблон Word

Question

Я использую форму VBA в Access 2010, чтобы заполнить шаблон Word данными из моих таблиц.

К сожалению, до сих пор я не могу добавить гиперссылку в текст.

Чтобы сделать вещи проще для меня, я вставляя все данные в таблицу в шаблоне, например так:

Private Sub button_Click() 

On Error GoTo myError 
Dim objWRD As Object 'Word.Application 
Dim objDoc As Object 'Word.Document 
Dim db As DAO.Database 
Dim rs As DAO.Recordset 
Dim strRecords As String 

'open a query and prepare the data' 
Set db = CurrentDb() 
Set qfd = db.QueryDefs("my_query") 
Set rs = qfd.OpenRecordset() 

'open a Word template' 
Set objWRD = CreateObject("Word.Application") 
objWRD.Visible = True 
Set objDoc = objWRD.Documents.Add("path_to_my_document_template", , , True) 
objWRD.ScreenUpdating = False 


'insert records into template' 
Dim i As Integer 
i = 1 
While Not rs.EOF 
    objDoc.Tables(i).Cell(2, 1).Range.Text = "" & rs("hyperlink") 
    objDoc.Tables(i).Cell(2, 2).Range.Text = "" & rs("description") 
    rs.MoveNext 
    i = i + 1 
Wend 

rs.Close 
Set rs = Nothing 

leave: 
    Exit Sub 
myError: 
    MsgBox Error$ 
    Resume Next 
End Sub 

Может кто-нибудь, пожалуйста, помогите мне, чтобы вставить рабочую гиперссылку на шаблон в rs("hyperlink") место?

Answer 1

Где вы ссылаетесь на ячейке таблицы держать гиперссылка, попробуйте следующее:

objDoc.Hyperlinks.add Anchor:=objDoc.tables(i).Cell(2, 1).Range, _ 
    Address:=rs("hyperlink") 

И добавить дополнительный текст в ту же ячейку (в данном случае я вставляя «Текст для вставки» до проведения гиперссылка

With objDoc.Tables(i).Cell(2, 1).Range 
    .Collapse Direction:=wdCollapseStart 
    .Text = "Text to Insert" & Chr(11) 
End With 

так что ваш While Loop будет выглядеть примерно так:.

Dim i As Integer 
    i = 1 
    While Not rs.EOF 

    objDoc.Hyperlinks.add Anchor:=objDoc.Tables(i).Cell(2, 1).Range, _ 
     Address:=rs("hyperlink") 
    With objDoc.Tables(i).Cell(2, 1).Range 
     .Collapse Direction:=wdCollapseStart 
     .Text = "Text to Insert" & Chr(11) 
    End With 
    objDoc.Tables(i).Cell(2, 2).Range.Text = "" & rs("description") 
     rs.MoveNext 
     i = i + 1 
    Wend