[Resolvido]Exportar Tabela via Código para o Word

Boa tarde pessoal,

Tenho o seguinte código para exportar dados de uma tabela no Access para o Word: A tabela tem três campos: PrimeiroNome, UltimoNome, Endereco.

Em um botão do formulário chamo esta sub-rotina:

Call FillWithTypeText

Ok. Um novo documento do Word se abre com x linhas e y colunas. Na primeira coluna entra o primeiro e último nome na segunda coluna fica em branco. Ok. Como fazer para que na segunda coluna entre o campo Endereco da tabela na exportação?

Private Sub FillWithTypeText() 'Preencha um texto tipado
'Código de Helen Feddema
On Error Resume Next

Dim appWord As Word.Application
Dim doc As Word.Document
Dim dbs As DAO.Database
Dim rst As DAO.Recordset

Set appWord = GetObject(, "Word.Application")
Set doc = appWord.Documents.Add
'Insira e formate o título de um documento:
With appWord.Selection
.Font.Size = 14
.Font.Bold = wdToggle
.TypeText "Contatos Atuais de " _
& Format(Date, "Long Date")
.Font.Size = 14
.Font.Bold = wdToggle
.TypeParagraph
.MoveLeft Unit:=wdWord, Count:=11, _
Extend:=wdExtend
.Font.Size = 14
.Font.Bold = wdToggle
.MoveDown Unit:=wdLine, Count:=1
End With
'Insira uma tabela de duas colunas para guardar os dados de contato (uma coluna para nomes de 'contato, a outra para os comentários do usuário):

doc.Tables.Add Range:=Selection.Range, _
NumRows:=6, _
NumColumns:=2, _
DefaultTableBehavior:=wdWord9TableBehavior, _
AutoFitBehavior:=wdAutoFitFixed
With appWord.Selection.Tables(1)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
'Os componentes do Office e o que eles fazem melhor:

.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
'Insira os dados do contato da tabela Access dentro da tabela Word:
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblContatos")
Do While Not rst.EOF
With appWord.Selection
.TypeText rst![UltimoNome] & ", " & rst![PrimeiroNome]
.MoveRight Unit:=wdCell, Count:=2
End With
rst.MoveNext
Loop

'Deleta a última linha em branco:
appWord.Selection.Rows.Delete

'Seleciona os nomes alfabeticamente:
doc.Tables(1).Select
appWord.Selection.Sort ExcludeHeader:=False, _
FieldNumber:="Column 1", _
SortFieldType:=wdSortFieldAlphanumeric, _
SortOrder:=wdSortOrderAscending
Set appWord = Nothing
Exit Sub
End Sub

Como não houve retorno, o tópico passa a resolvido. Qualquer coisa reabra, por favor.