Создание документа MS Word из кода VB

Private Sub Command2_Click()
If Data1.Recordset.RecordCount > 0 Then
Data1.Recordset.MoveLast
Data1.Recordset.MoveFirst
Set WordApp = New Word.Application
On Error Resume Next
WordApp.Documents.Add (App.Path & 'SunSparkHeb.dot')
dat = Format(Date, 'dd.MM.yyyy')
Set doc = WordApp.ActiveDocument
Set sel = WordApp.Selection
strText = 'list of students of course: ' & Trim(Label1.Caption) & ' Group: ' & Left(Me.Caption, 5)
sel.TypeText ('date: ' & dat) 'p1
sel.TypeText (vbCr & strText & vbCr & vbCr) 'p2
If ind1 > 0 Then
doc.Tables.Add Range:=sel.Range, numrows:=1, numcolumns:=7
Else
doc.Tables.Add Range:=sel.Range, numrows:=1, numcolumns:=6
End If
sel.TypeText ('# ID') 'p3
sel.Columns(1).Width = 35
sel.MoveRight (12)
sel.TypeText ('first and last name')
'sel.Columns(1).Width = 65
sel.MoveRight (12)
sel.TypeText ('passport')
'sel.Columns(1).Width = 67
sel.MoveRight (12)
sel.TypeText ('years old')
'sel.Columns(1).Width = 65
sel.MoveRight (12)
sel.TypeText ('address')
'sel.Columns(1).Width = 65
sel.MoveRight (12)
sel.TypeText ('phones')
'sel.Columns(1).Width = 35
If ind1 > 0 Then
sel.MoveRight (12)
'sel.TypeText ('e-mail') 'p76
sel.TypeText ('payments')
End If
'sel.Columns(1).Width = 100
Set db = OpenDatabase(dabName)
Do While Not Data1.Recordset.EOF
sel.MoveRight (12)
sel.TypeText ('' & Data1.Recordset!count_num)
sel.MoveRight (12)
sel.TypeText ('' & Trim(Data1.Recordset!f_name) & ' ' & Trim(Data1.Recordset!l_name))
sel.MoveRight (12)
sel.TypeText ('' & Data1.Recordset!tzeut)
sel.MoveRight (12)
sel.TypeText ('' & Str((Year(Date - CDate(Data1.Recordset!d_bir))) - 1900))
sel.MoveRight (12)
sel.TypeText ('' & Trim(Data1.Recordset!street) & ' ' & Trim(Data1.Recordset!town) & ' ' & Trim(Data1.Recordset!home) & ' ' & Trim(Data1.Recordset!flat))
strTel = ''
If Trim(Data1.Recordset!f_home) <> '' Then
strTel = strTel & Trim(Data1.Recordset!f_home)
End If
If Trim(Data1.Recordset!f_work) <> '' Then
If Trim(strTel) = '' Then
strTel = strTel & Trim(Data1.Recordset!f_work)
Else
strTel = strTel & vbCr & Trim(Data1.Recordset!f_work)
End If
End If
If Trim(Data1.Recordset!f_mobile) <> '' Then
If Trim(strTel) = '' Then
strTel = strTel & Trim(Data1.Recordset!f_mobile)
Else
strTel = strTel & vbCr & Trim(Data1.Recordset!f_mobile)
End If
End If
sel.MoveRight (12)
sel.TypeText (strTel) 'p5
If ind1 > 0 Then
sel.MoveRight (12)
Set rs0 = db.OpenRecordset('select * from contact where nir_num=' & Data1.Recordset!nir_num, dbOpenDynaset, False, dbOptimistic)
rs0.MoveFirst
sel.TypeText ('price ' & rs0!sum_all & vbCr & 'payment ' & rs0!sum_plat + rs0!sum_avans & vbCr & 'ostatok' & rs0!sum_all - rs0!sum_plat - rs0!sum_avans)
rs0.Close
End If
Data1.Recordset.MoveNext
Loop
db.Close
Data1.Recordset.MoveFirst
WordApp.Documents(1).Paragraphs(1).Alignment = wdAlignParagraphLeft
WordApp.Documents(1).Paragraphs(2).Style = 'H3'
WordApp.Documents(1).Paragraphs(2).Alignment = wdAlignParagraphCenter
WordApp.Visible = True
Set WordApp = Nothing
End If
End Sub