I am programming a Word document using Excel VBA. Can someone please help me get rid of Run Time Error 462, (the remote server does not exist or is unavailable)? I know that this is a common problem that occurs the second time a procedure is run, and I haver read many posts about it, but I still cannot determine what I am doing wrong.
VBA Code:
Private Sub CreateOldRoster()
Dim OldRoster As Word.Application
Dim SaveName As String, LabelDate As String, yr As String, fullyr As String
Dim WkSht As Worksheet
Dim rng As Word.Range, s As Word.Section, hf As Word.HeaderFooter
Dim hdr As Word.HeaderFooter
Dim OldR As Word.Document
Dim aTbl As Word.Table, aCell As Word.cell
Dim WordOpen As Boolean
WordOpen = False
Set WkSht = ThisWorkbook.Worksheets("ROSTER")
Set OldRoster = CreateObject("Word.Application")
WordOpen = True
If MsgBox("Select Yes to label the roster for this month (" & Format(Now, "mmmm") & _
") or No to label as next month (" & Format(CDate(Format(Now, "MMMM") & "/2 0") + 30, "mmmm") & _
")", vbYesNo) = vbNo Then
LabelDate = Format(CDate(Format(Now, "MMMM") & "/2 0") + 30, "mmmm")
Else
LabelDate = Format(Now, "MMMM")
End If
If (Format(Now, "mmmm") <> LabelDate) And (LabelDate = "January") Then
yr = Trim(Format(Now, "YY") + 1)
fullyr = Trim(Format(Now, "YYYY") + 1)
Else
yr = Format(Now, "YY")
fullyr = Format(Now, "YYYY")
End If
SaveName = "C:\OEN\ActiveByCityRoster" & LabelDate & yr & ".docx"
'~~> Check if word file exists
If Dir(SaveName) <> "" Then
If MsgBox("File already exists for this month. Delete it?", vbYesNo) = vbYes Then
Kill SaveName
Else
MsgBox "Keeping old file and exiting."
GoTo cleanup
End If
End If
With OldRoster
.Documents.Add "C:\OEN\ActiveCityRosterTemplate.dotx"
.Visible = True
.Activate
With WkSht
.Range("A1:J" & Rows.Count).Copy
End With
.Documents(1).Content.Font.Size = 10
OldRoster.Selection.Paste
[B]' ********* BELOW IS THE OFFENDING LINE. IT WORKS THE FIRST TIME.[/B]
OldRoster.ActiveDocument.Tables(1).Rows.SetHeight RowHeight:=InchesToPoints(0.4), HeightRule:=wdRowHeightExactly
Application.ScreenUpdating = False
With OldRoster.ActiveDocument.Sections.First
With .Headers(wdHeaderFooterPrimary).Range
.Collapse wdCollapseEnd
.Text = " " & vbLf & " " & LabelDate & " " & fullyr
.Font.Name = "Arial"
End With
End With
Application.ScreenUpdating = True
OldRoster.ActiveDocument.Tables(1).Rows(1).HeadingFormat = True
OldRoster.ActiveDocument.SaveAs2 SaveName
OldRoster.ActiveDocument.Close
End With
If WordOpen Then OldRoster.Quit
cleanup:
Set OldRoster = Nothing
Set WkSht = Nothing
Set OldR = Nothing
Set aTbl = Nothing
End Sub
As soon as I finished posting this, I found another anser that told me to add this to the top of my code
