Hi all I am new here,
and have already a question regardig a macro..
Unfortunatelly I am pretty new to word vba and can not finde a solution to this problem.
I like to write data from access to word .. the following code I got from a book but I recieve a error object not found..
Code:
Private Sub FillWithTypeText()
On Error GoTo ErrorHandler
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
'insert format document titel
With appWord.Selection
.TypeText "Aktuelle Kontakte mit " _
& Format(Date, "Long Date")
.TypeParagraph
.MoveLeft Unit:=wdWord, count:=11, _
Extend:=wdExtend
.Font.Size = 14
.Font.Bold = wdToggle
.MoveDown Unit:=wdLine, count:=1
End With
'insert two column table to hold contact data(one column for contact names, the other for user comments)
doc.Tables.Add Range:=Selection.Range, _
NumRows:=1, _
NumColumns:=2, _
DefaultTableBehavior:=wdWord9TableBehavior, _
AutoFitBehavior:=wdAutoFitFixed
With appWord.Selection.Tables(1)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
'insert contact Data from Access table into Word table:
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblKunden")
Do While Not rst.EOF
With appWord.Selection
.TypeText rst![kunKundenAnzeigen]
.MoveRight Unit:=wdCell, count:=2
End With
rst.MoveNext
Loop
'Delete the last names alphabetically:
doc.Tables(1).Select
appWord.Selection.Sort excludeheader:=False, _
fieldnumber:="Column 1", _
sortfieldtype:=wdSortFieldAlphanumeric, _
SortOrder:=wdSortOrderAscending
ErrorHandlerExit:
Set appWord = Nothing
Exit Sub
ErrorHandler:
If Err = 429 Then
'Word is not running: open Word with createObject:
Set appWord = CreateObject("Word.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number _
& " ; Description: " & Err.Description
Resume ErrorHandlerExit
End If
End Sub
The code jumpes from the line in red into the MsgBox Error No....
So what am I missing here in this code? The code is writen in VBA 2007 ... and I got 2010 but not sure if that makes a difference.
Maybe someone knows what has to be changed so the code can run.
Many thanks in advance!!
Silentwolf :-)