Error trying to save Word document from Excel

[sharky12345]

Guys,

I'm getting 2 errors whilst trying to create a Word document from a template.

The code I'm using is this;

Dim WdApp As Object
Dim myDoc As Object
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set WdApp = CreateObject("Word.Application")

With WdApp
.Visible = True
.WindowState = wdWindowStateMaximize
End With

Set myDoc = WdApp.Documents.Add(Template:=ThisWorkbook.Path & "\Actions\Blank Action.dotx")

With myDoc.Bookmarks
.Item("Name").Range.InsertAfter "Operational " & Sheet5.Range("B1").Value
.Item("Number").Range.InsertAfter IssueActionFrm.TextNumber.Value
.Item("Data").Range.InsertAfter Sheet5.Range("B4").Value
.Item("Priority").Range.InsertAfter IssueActionFrm.ComboGrading.Value
.Item("Originator").Range.InsertAfter "SIO"
.Item("Details").Range.InsertAfter Chr(10) & IssueActionFrm.TextDetails.Value & Chr(10)
.Item("AllocatedTo").Range.InsertAfter IssueActionFrm.TextAllocation.Value
.Item("Date").Range.InsertAfter Format(Now, "dd/mm/yyyy hh:mm")
.Item("By").Range.InsertAfter Environ("username")

If IssueActionFrm.CheckTest.Value = True Then
.Item("Test").Range.InsertAfter "YES"
End If

If IssueActionFrm.CheckVideo.Value = True Then
.Item("Video").Range.InsertAfter "YES"
.Item("Reason").Range.InsertAfter IssueActionFrm.TextReason.Value
End If

If IssueActionFrm.TextGrading.Value = "" Then
Else
.Item("Grading").Range.InsertAfter Chr(10) & IssueActionFrm.Grading.Value & Chr(10)
End If

End With

myDoc.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
myDoc.SaveAs ThisWorkbook.Path & "\Actions\" & IssueActionFrm.TextNumber.Value & ".docx"

Select Case MsgBox("Do you want to email this Action to a recipient?", vbYesNo Or vbQuestion Or vbDefaultButton1, "Email Action")

Case vbYes

With OutMail
.To = IssueActionFrm.TextAllocation.Value
.CC = ""
.BCC = ""
.Subject = Sheet1.Range("H4").Value & " - Action " & IssueActionFrm.TextNumber.Value
.body = ""
.Attachments.Add ThisWorkbook.Path & "\Actions\" & IssueActionFrm.TextNumber.Value & ".docx"
.display
End With
Set OutMail = Nothing
Set OutApp = Nothing

Case vbNo

End Select

WdApp.NormalTemplate.Saved = True
Application.DisplayAlerts = False
myDoc.Saved = True
WdApp.Quit

Set WdApp = Nothing
Set myDoc = Nothing

The first error I get is;

Error -2147023170: Automation error. The remote procedure call failed

That error is generated on this line;

WdApp.NormalTemplate.Saved = True

I then get the following;

Error 462: The remote server machine does not exist or is unavailable

and that is generated on these 2 lines;

myDoc.Saved = True
WdApp.Quit

The odd thing is that this works fine on my home PC, but when I use it at work on a network that's when the errors are generated.

I appreciate this is actually 2 problems, but I'm sure they must be connected so can anyone spot where my problem is please?

 

[NdNoviceHlp]

U don't save a template... U just want to close it. It is a template that U don't want to change. U want to save the template that U made changes to as a new document ie. with a new name. So, Mydoc saveas some file name is what U should do. HTH. Dave

Mydoc.SaveAs (Filepath & Filename & ".docx")

U need to specify the filepath & filename & file extension

 

[Macropod]

U don't save a template... U just want to close it. It is a template that U don't want to change. U want to save the template that U made changes to as a new document ie. with a new name. So, Mydoc saveas some file name is what U should do. HTH. Dave

Mydoc.SaveAs (Filepath & Filename & ".docx")

U need to specify the filepath & filename & file extension

You would if you had changed the template but didn't want to save those changes or be prompted about them when exiting Word. But that's not what sharky12345 is doing. Note that the line in question does not save the template; it only tells Word that it has been saved, which is quite different.

sharky12345: There are numerous inconsistencies and apparent errors in your code. Inconsistencies include declarations of Word as an object, which implies late binding, but then using Word constants in a way that presupposes early binding. Apparent errors include the use of 'Sheet5', which presumably refers to a worksheet of that name, but that isn't how you'd reference such a sheet unless 'Sheet5' had already been declared as a variable - which your code gives no evidence of. Try:

Dim WdApp As Object, myDoc As Object, OutApp As Object, OutMail As Object
Const wdAllowOnlyFormFields As Long = 2: Const wdFormatXMLDocument As Long = 12
Set WdApp = CreateObject("Word.Application")

With WdApp
  .Visible = True
  Set myDoc = .Documents.Add(Template:=ThisWorkbook.Path & "\Actions\Blank Action.dotx")
  With myDoc
    .Bookmarks("Name").Range.InsertAfter "Operational " & ActiveWorkbook("Sheet5").Range("B1").Value
    .Bookmarks("Number").Range.InsertAfter IssueActionFrm.TextNumber.Value
    .Bookmarks("Data").Range.InsertAfter ActiveWorkbook("Sheet5").Range("B4").Value
    .Bookmarks("Priority").Range.InsertAfter IssueActionFrm.ComboGrading.Value
    .Bookmarks("Originator").Range.InsertAfter "SIO"
    .Bookmarks("Details").Range.InsertAfter Chr(10) & IssueActionFrm.TextDetails.Value & Chr(10)
    .Bookmarks("AllocatedTo").Range.InsertAfter IssueActionFrm.TextAllocation.Value
    .Bookmarks("Date").Range.InsertAfter Format(Now, "dd/mm/yyyy hh:mm")
    .Bookmarks("By").Range.InsertAfter Environ("username")

    If IssueActionFrm.CheckTest.Value = True Then
      .Bookmarks("Test").Range.InsertAfter "YES"
    End If

    If IssueActionFrm.CheckVideo.Value = True Then
      .Bookmarks("Video").Range.InsertAfter "YES"
      .Bookmarks("Reason").Range.InsertAfter IssueActionFrm.TextReason.Value
    End If

    If IssueActionFrm.TextGrading.Value <> "" Then
      .Item("Grading").Range.InsertAfter Chr(10) & IssueActionFrm.Grading.Value & Chr(10)
    End If

    .Protect wdAllowOnlyFormFields, True
    .SaveAs2 ThisWorkbook.Path & "\Actions\" & IssueActionFrm.TextNumber.Value & ".docx", _
      wdFormatXMLDocument, , , False
    .Close False
  End With
  .NormalTemplate.Saved = True
  .Quit
End With

If MsgBox("Do you want to email this Action to a recipient?", vbYesNo, "Email Action") = vbYes Then
  Set OutApp = CreateObject("Outlook.Application"): Set OutMail = OutApp.CreateItem(0)
  With OutMail
    .To = IssueActionFrm.TextAllocation.Value
    .CC = ""
    .BCC = ""
    .Subject = ActiveWorkbook("Sheet1").Range("H4").Value & " - Action " & IssueActionFrm.TextNumber.Value
    .body = ""
    .Attachments.Add ThisWorkbook.Path & "\Actions\" & IssueActionFrm.TextNumber.Value & ".docx"
    .display
  End With
End If

Set WdApp = Nothing: Set myDoc = Nothing: Set OutMail = Nothing: Set OutApp = Nothing

All of the above assumes late binding, which means you don't need to set a reference to Word or Outlook.

 

[sharky12345]

Guys, thank you so much for your replies.

Paul - thanks to you especially because I've only recently started using Late Binding, (I've never had the need to previously but now starting to understand it), and that's why the code is all over the place but I will try your suggestion so thank you!