Export specific excel range to word (remote server machine)

YasserKhalil · Mar 22, 2016

Hello everyone
I have this code that would export excel range to word
It works well for first running but when executing it for a second time I encountered an error
(The remote server machine doesn't exist or is unavailable)

Code:

Sub SaveToWord()
    Dim S_ALI$
    Dim SAV_ALI As String
    Dim tbl As Excel.Range
    Dim WordApp As Word.Application
    Dim myDoc As Word.Document
    Dim WordTable As Word.Table
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        SAV_ALI = ThisWorkbook.Path & "\" & ActiveSheet.Name & "\"
        S_ALI = Range("C3") & ".docx"
        Set tbl = ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)
       
        On Error Resume Next
            Set WordApp = GetObject(class:="Word.Application")
            Err.Clear
            If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
            If Err.Number = 429 Then
                MsgBox "Microsoft Word could not be found, aborting."
                GoTo EndRoutine
            End If
        On Error GoTo 0
       
        WordApp.Visible = True
        WordApp.WindowState = wdWindowStateMinimize
       
        Set myDoc = WordApp.Documents.Add
        tbl.Copy
        myDoc.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
       
        With ActiveDocument.PageSetup
            .LineNumbering.Active = False
            .TopMargin = CentimetersToPoints(1)
            .BottomMargin = CentimetersToPoints(1)
            .LeftMargin = CentimetersToPoints(1)
            .RightMargin = CentimetersToPoints(1)
        End With
       
        Set WordTable = myDoc.Tables(1)
        WordTable.AutoFitBehavior (wdAutoFitWindow)
       
        With ActiveDocument
            On Error Resume Next
            MkDir SAV_ALI
            ActiveDocument.SaveAs SAV_ALI & ActiveSheet.Name & " " & S_ALI
        End With
       
        With WordApp
            .ActiveDocument.Close
            .Quit
        End With
       
        Set WordApp = Nothing
EndRoutine:
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Hope to find solution

Debaser · Mar 22, 2016

Use myDoc not ActiveDocument.

YasserKhalil · Mar 22, 2016

I actually tried to replace the ActiveDocument with myDoc
The code works fine for the first time only but as for the second time the error occurs and this is weird ..

Debaser · Mar 22, 2016

What was the exact updated code you tried? I assume you closed all the existing hidden winword.exe processes first?

YasserKhalil · Mar 22, 2016

I think this part do this task

Code:

With WordApp
            .ActiveDocument.Close
            .Quit
        End With
    
        Set WordApp = Nothing

Any suggestion related to this part

Have you tried the sample workbook and run the code twice?
How can I close all the existing hidden winword.exe processes

Debaser · Mar 22, 2016

Use task manager. That code won't suffice because you have created implicit object references to the word document that haven't been released.

YasserKhalil · Mar 22, 2016

Thanks again
I opened task manager after executing the code for the first time but I didn't find winword in the processes!!!

Debaser · Mar 22, 2016

And do you still get an error on the next run?

YasserKhalil · Mar 22, 2016

Yes I still get the same error for the next run ..
Please try the sample workbook by yourself to see the problem well
Run for the first time .. run again and see the problem

Chihiro · Mar 22, 2016

Several issues here.

You are using "CentimetersToPoints" method without explicitly qualifying it as WordApp object model.

And as Debaser stated, swap ActiveDocument to myDoc.

This should work.

Code:

Option Explicit

Sub SaveToWord()
    Dim S_ALI$
    Dim SAV_ALI As String
    Dim tbl As Excel.Range
    Dim WordApp As Word.Application
    Dim myDoc As Word.Document
    Dim WordTable As Word.Table
  
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        SAV_ALI = ThisWorkbook.Path & "\" & ActiveSheet.Name & "\"
        S_ALI = Range("C3") & ".docx"
        Set tbl = ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)
      
        On Error Resume Next
            Set WordApp = GetObject(class:="Word.Application")
            Err.Clear
            If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
            If Err.Number = 429 Then
                MsgBox "Microsoft Word could not be found, aborting."
                GoTo EndRoutine
            End If
        On Error GoTo 0
      
        WordApp.Visible = True
        WordApp.WindowState = wdWindowStateMinimize
      
        Set myDoc = WordApp.Documents.Add
        tbl.Copy
        myDoc.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
      
        With myDoc.PageSetup
            .LineNumbering.Active = False
            .TopMargin = WordApp.CentimetersToPoints(1)
            .BottomMargin = WordApp.CentimetersToPoints(1)
            .LeftMargin = WordApp.CentimetersToPoints(1)
            .RightMargin = WordApp.CentimetersToPoints(1)
        End With
      
        Set WordTable = myDoc.Tables(1)
        WordTable.AutoFitBehavior (wdAutoFitWindow)
      
        With myDoc
            On Error Resume Next
            MkDir SAV_ALI
            myDoc.SaveAs SAV_ALI & ActiveSheet.Name & " " & S_ALI
        End With
      
        Set tbl = Nothing
        Set WordTable = Nothing
        Set myDoc = Nothing
        WordApp.Quit
        Set WordApp = Nothing
EndRoutine:
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Debaser · Mar 22, 2016

Centimeterstopoints is an Excel method too.

Chihiro · Mar 22, 2016

Hmm, for some reason, it was erroring out for me at the point until I added WordApp.

Chihiro · Mar 22, 2016

Ah, I think I know the reason why that line throws error on second run without "WordApp."

See link and scroll down to "Unqualified References"
https://support.microsoft.com/en-us/kb/319832

YasserKhalil · Mar 22, 2016

Thank you very much Mr. Chihiro
Now it is working like charm ..
Can you focus on the changes you have made so as to learn where was the problem exactly
I noticed as for Centimeterstopoints you added WordApp .. is there anything else?

Chihiro · Mar 22, 2016

All references to ActiveDocument was swapped out with myDoc.

Added "WordApp." in front of all Centimeterstopoints.

Also added following to set all references to "Nothing".

You may not need all of them, test by commenting out one by one.

Code:

Set tbl = Nothing
Set WordTable = Nothing
Set myDoc = Nothing
WordApp.Quit
Set WordApp = Nothing

YasserKhalil · Mar 22, 2016

Thanks a lot for this great explanation
You are GREAT Mr. Chihiro
Best and Kind Regards

Debaser · Mar 23, 2016

Chihiro said:
Hmm, for some reason, it was erroring out for me at the point until I added WordApp.

Sorry, what I meant was you can just use Application rather than wordApp since it's in Excel too.

YasserKhalil · Mar 23, 2016

Have you tried this point and used Application instead of WordApp?
I think the error will remain ..

Debaser · Mar 23, 2016

Did you try it?

YasserKhalil · Mar 23, 2016

I tried it once but it gives me error for the second instance
I may go in the wrong way
Please post your try to see if it works or not

Debaser · Mar 23, 2016

Code:

Sub SaveToWord()
    Dim S_ALI$
    Dim SAV_ALI               As String
    Dim tbl                   As Excel.Range
    Dim WordApp               As Word.Application
    Dim myDoc                 As Word.Document

    Application.ScreenUpdating = False
    Application.EnableEvents = False
   
    SAV_ALI = ThisWorkbook.Path & "\" & ActiveSheet.Name & "\"
    S_ALI = Range("C3") & ".docx"
    Set tbl = ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)

    On Error Resume Next
    Set WordApp = GetObject(class:="Word.Application")
    Err.Clear
    If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
    If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        GoTo EndRoutine
    End If
    On Error GoTo 0

    With WordApp
        .Visible = True
        .WindowState = wdWindowStateMinimize
        Set myDoc = .Documents.Add
    End With

    tbl.Copy

    myDoc.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

    With myDoc.PageSetup
        .LineNumbering.Active = False
        .TopMargin = Application.CentimetersToPoints(1)
        .BottomMargin = Application.CentimetersToPoints(1)
        .LeftMargin = Application.CentimetersToPoints(1)
        .RightMargin = Application.CentimetersToPoints(1)
    End With

    myDoc.Tables(1).AutoFitBehavior wdAutoFitWindow

    On Error Resume Next
    MkDir SAV_ALI
    myDoc.SaveAs SAV_ALI & ActiveSheet.Name & " " & S_ALI

    myDoc.Close
    WordApp.Quit

    Set WordApp = Nothing
EndRoutine:
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

YasserKhalil · Mar 23, 2016

Thank you very much .. It is working now
That's weird I tried the same approach but I got the error ..
Generally it is working very well now
Best and Kind Regards

Debaser · Mar 23, 2016

That's why I asked you to post the revised code you had tried. Very difficult to debug it for you otherwise.

Export specific excel range to word (remote server machine)

Well-Known Member

Attachments

Well-Known Member

Well-Known Member

Well-Known Member

Well-Known Member

Well-Known Member

Well-Known Member

Well-Known Member

Well-Known Member

Excel Ninja

Well-Known Member

Excel Ninja

Excel Ninja

Well-Known Member

Excel Ninja

Well-Known Member

Well-Known Member

Well-Known Member

Well-Known Member

Well-Known Member

Well-Known Member

Well-Known Member

Well-Known Member