Error 642 in Word Automation and Style that is not applied
Hello,
I am trying to create a code that takes data from an array (in excel) and creates a word document.
The array might be something like:
Log name
Expense Group 1
Lab 1
Person
Person
Person
Lab 2
Person
Person
Lab 3
Person
Person
Person
Person
Lab 3
Person
Expense Group 2
Lab 1
Person
Person
Lab 2
Person
Lab 3
Person
Person
Person
Lab 3
Person
Person
Person
So what my code does is to read each element and applies certain Style according to the element (Title, Expense group, Lab or person)
But this array may vary in the number of labs and persons. That's why I don't use bookmarks.
But my code has two problems:
- The second time I execute it it displays a 462 error "server not found" (in green)
- It applies all the styles except the Heading 1 style. (in red)
here's my code:
[vba]
Sub createVar15ReportWord(Optional expensearray As Variant, Optional hcarray As Variant)
' You must pick Microsoft Word 14.0 from Tools>References
' in the VB editor to execute Word commands.
Dim appWD As Word.Application
Dim workarray() As Variant
Dim str As String
Dim budgetnum As Integer
'Dim fileWD As Word.Document
budgetnum = 1
'_________ CREATING A NEW INSTANCE OF WORD AND MAKE IT VISIBLE _______________________
Set appWD = CreateObject("Word.Application")
appWD.Visible = True
' Tell Word to create a new document
appWD.Documents.Add
'Set fileWD = appWD.ActiveDocument
'we save the Word Document
'fileWD.SaveAs "Testing.docx"
' Tell Word to paste the contents of the clipboard into the new document
'appWD.Selection.Paste
'__________________________________________________________________________ _______
'## WRITING THE TITLE OF THE REPORT ##
str = "Log File for Month Actuals Check - " & Strings.format(Now, "ddd, d-mmmm-yyyy hh:mm") & "."
On Error Resume Next
appWD.Selection.Style = ActiveDocument.Styles("Title")
On Error GoTo ErrHandler
appWD.Selection.TypeText Text:=str
For m = 1 To 2
If m = 1 Then
workarray = expensearray
Else
workarray = hcarray
End If
'## WRITING THE BUDGET TITLE ##
str = workarray(0)
If budgetnum = 1 Then
budgetnum = 2
appWD.Selection.TypeParagraph
appWD.Selection.Style = ActiveDocument.Styles("Normal")
appWD.Selection.TypeText Text:=" "
appWD.Selection.TypeParagraph
End If
appWD.Selection.Style = ActiveDocument.Styles("Heading 1")
appWD.Selection.TypeText Text:=str
Debug.Print "Heading 1 es: " & str
'## WRITING THE EXPENSES REPORT DATA ##
For i = 2 To UBound(workarray)
str = workarray(i)
'## WRITING THE EXPENSES LAB TITLE ##
If Left(str, 4) = "Lab:" Then
If i <> UBound(workarray, 1) Then
If Left(workarray(i + 1), 4) <> "Lab:" Then
appWD.Selection.Style = ActiveDocument.Styles("Normal")
appWD.Selection.TypeParagraph
appWD.Selection.TypeParagraph
appWD.Selection.Style = ActiveDocument.Styles("Heading 2")
appWD.Selection.TypeText Text:=str
appWD.Selection.TypeParagraph
appWD.Selection.TypeParagraph
With appWD.ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = ChrW(61623)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = CentimetersToPoints(0.63)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(1.27)
.TabPosition = wdUndefined
.ResetOnHigher = 0
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.Strikethrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.Allcaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = "Symbol"
End With
.LinkedStyle = ""
End With
appWD.ListGalleries(wdBulletGallery).ListTemplates(1).Name = ""
appWD.Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior
End If
End If
Else
str = workarray(i)
appWD.Selection.TypeText Text:=str
appWD.Selection.TypeParagraph
End If
Next
If m = 1 Then
appWD.Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
appWD.Selection.TypeParagraph
appWD.Selection.InsertBreak Type:=wdPageBreak
End If
Next
appWD.Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
'__________________________________________________________________________ ________
' Save the new document with a sequential file name
If username = "" Then username = Environ("username")
docname = ThisWorkbook.Path & "\MS_WORD_Reports_Folder\Flash_Check_File_Var15percent_" & username & "_" & Strings.format(Now, "dd-mmmm-yyyy hh_mm")
appWD.ActiveDocument.SaveAs FILENAME:=docname
' Close this new word document
appWD.ActiveDocument.Close
' Close the Word application
appWD.Quit
Set appWD = Nothing
'Inform the tool that this report has been created.
wordreport = True
Exit Sub
ErrHandler:
MsgBox "It has been detected that an instance of MS Word might be open or stored in memory, so the Copy of the report in MS Word could not be made.", vbCritical, "Word Report not created"
appWD.ActiveDocument.Close False ' close the document without saving
appWD.Quit
Set appWD = Nothing
End Sub
[/vba]
Any help would be much appreciated.
