Trouble setting new active document

Dear Experts

I am trying to write some VBA code to export data from Access & then format the results, which are a series of RTF documents. The code to export & do the formatting is fine but what happens is this - it goes through the code and formats the first one all fine, it does appear to save it and close it, but when it moves on the next RTF document the document does open (I can see it on the screen), but I get a run-time error '462' - the remote server machine does not exist or is unavailable & highlights line 243 implying that the second rtf document isn't active.  There are no other instances of word open

The code is below can anybody help?

Private Sub Run_Click()
    Dim strFilter As String
    Dim lngFlags As Long
    Dim strStartDir As String
' Lets start the file browse from our current directory
     
    strStartDir = Environ("userProfile") & "\desktop"

    strStartDir = Left(strStartDir, Len(strStartDir) - Len(Dir(strStartDir)))

    
    strFilter = ahtAddFilterItem(strFilter, _
                        "All Files (*.*)", "*.*")
    Me.ImportSpreadsheet = ahtCommonFileOpenSave(InitialDir:=strStartDir, _
                     Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
                     DialogTitle:="Select database")
                     
' Move to right place
Dim FilePathOriginal As String
Dim FilePathDestination As String
FilePathOriginal = Me.ImportSpreadsheet
FilePathDestination = CurrentProject.Path & "\System Files\OriginalSpreadsheet.xlsx"

'check System Files folder exists
Dim fso
Dim fol As String
fol = CurrentProject.Path & "\System Files"
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fol) Then
    fso.CreateFolder (fol)
End If

'check Results folder exists
Dim fso1
Dim fol1 As String
fol1 = CurrentProject.Path & "\Results"
Set fso1 = CreateObject("Scripting.FileSystemObject")
If Not fso1.FolderExists(fol1) Then
    fso1.CreateFolder (fol1)
End If

FileCopy FilePathOriginal, FilePathDestination

Dim OutputFolder As String
OutputFolder = CurrentProject.Path & "\System Files\"

Dim OutputFileNotInPlay As String
Dim OutputFileResearchStage As String
Dim OutputFileShortlist As String

OutputFileShortlist = OutputFolder & "Potential Shortlist.rtf"
OutputFileResearchStage = OutputFolder & "Candidates at Research Stage.rtf"
OutputFileNotInPlay = OutputFolder & "Candidates No Longer in Process.rtf"

    DoCmd.OutputTo acOutputQuery, "Potential Shortlist", "RichTextFormat(*.rtf)", OutputFileShortlist, False, "", , acExportQualityPrint
    DoCmd.OutputTo acOutputQuery, "Research Stage", "RichTextFormat(*.rtf)", OutputFileResearchStage, False, "", , acExportQualityPrint
    DoCmd.OutputTo acOutputQuery, "Rejected", "RichTextFormat(*.rtf)", OutputFileNotInPlay, False, "", , acExportQualityPrint

' .............................................................................................
'Open & Manipulate Potential Shortlist
Dim WordApp As Word.Application
Dim WordDocument As Word.Document
Set WordApp = CreateObject("Word.Application")
WordApp.Documents.Open (OutputFileShortlist)
WordApp.Documents.Save
WordApp.Visible = True
     
    
'manipulate RTF doc bit
    With ActiveDocument
    
'Sort Out Page Orientation
        If Selection.PageSetup.Orientation = wdOrientPortrait Then
        Selection.PageSetup.Orientation = wdOrientLandscape
    Else
        Selection.PageSetup.Orientation = wdOrientPortrait
    End If
    
'Set Candidate name to be bold
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Bold = True
    With Selection.Find
        .Text = "(||)(*)(\>\>)"
        .Replacement.Text = "\2"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
     With ActiveDocument.Styles(wdStyleNormal).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = CentimetersToPoints(2.75)
        .BottomMargin = CentimetersToPoints(2.25)
        .LeftMargin = CentimetersToPoints(2.54)
        .RightMargin = CentimetersToPoints(2.54)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.27)
        .FooterDistance = CentimetersToPoints(1.27)
        .PageWidth = CentimetersToPoints(29.7)
        .PageHeight = CentimetersToPoints(21)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = True
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With

'
' SortOutTable Macro

'Set cell Padding

    With Selection.Tables(1)
        .TopPadding = CentimetersToPoints(0.2)
        .BottomPadding = CentimetersToPoints(0.2)
        .LeftPadding = CentimetersToPoints(0.2)
        .RightPadding = CentimetersToPoints(0.2)
        .Spacing = 0
        .AllowPageBreaks = True
        .AllowAutoFit = True
    End With
       
'Set Column Widths

    Dim tbl As Table
    Set tbl = ActiveDocument.Tables(1)
    tbl.AllowAutoFit = False
    tbl.Columns.PreferredWidthType = wdPreferredWidthPoints
    tbl.Columns(1).PreferredWidth = CentimetersToPoints(4.2)
    tbl.Columns(2).PreferredWidth = CentimetersToPoints(7)
    tbl.Columns(3).PreferredWidth = CentimetersToPoints(10)
    tbl.Columns(4).PreferredWidth = CentimetersToPoints(3.8)
   

 'Set Border Colours
    Selection.Tables(1).Select
    Options.DefaultBorderColor = 192
        With Selection.Borders(wdBorderTop)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderLeft)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderBottom)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderRight)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderHorizontal)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderVertical)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    

    
'Format font & shading 1st Row
    Selection.Tables(1).Rows(1).Shading.Texture = wdTextureNone
    Selection.Tables(1).Rows(1).Shading.ForegroundPatternColor = wdColorAutomatic
    Selection.Tables(1).Rows(1).Shading.BackgroundPatternColor = -603917569
     With ActiveDocument.Tables(1).Rows(1).Range
        .Font.Bold = True
        .Font.Color = 2950080
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
    End With
       
'Set Row Height
    For Each tbl In ActiveDocument.Tables
        tbl.Rows.HeightRule = wdRowHeightAtLeast
        tbl.Rows.Height = CentimetersToPoints(0.6)
    Next
       
       
    Selection.Tables(1).Rows.AllowBreakAcrossPages = True
    Selection.Tables(1).Rows.HeadingFormat = False
    
'  End of Word formatting & convert to docx & move to results folder
Dim ResultsDirectory As String
ResultsDirectory = CurrentProject.Path & "\Results\"
    ChangeFileOpenDirectory _
        ResultsDirectory
    ActiveDocument.SaveAs2 FileName:="Potential Shortlist.docx", FileFormat _
        :=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14

    .Close (Word.WdSaveOptions.wdSaveChanges)
    WordApp.Quit
    Set WordApp = Nothing
    Call KillProcess("Winword.exe")
 
    End With
' .............................................................................................

'Open & Manipulate Candidates No Longer in Process
    
Dim WordApp1 As Word.Application
Dim WordDocument1 As Word.Document
Set WordApp1 = CreateObject("Word.Application")
WordApp1.Documents.Open (OutputFileNotInPlay)
WordApp1.Documents.Save
WordApp1.Visible = True
   
'manipulate RTF doc bit
    With ActiveDocument
    
'Sort Out Page Orientation
        If Selection.PageSetup.Orientation = wdOrientPortrait Then
        Selection.PageSetup.Orientation = wdOrientLandscape
    Else
        Selection.PageSetup.Orientation = wdOrientPortrait
    End If
    
'Set Candidate name to be bold
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Bold = True
    With Selection.Find
        .Text = "(||)(*)(\>\>)"
        .Replacement.Text = "\2"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
     With ActiveDocument.Styles(wdStyleNormal).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = CentimetersToPoints(2.75)
        .BottomMargin = CentimetersToPoints(2.25)
        .LeftMargin = CentimetersToPoints(2.54)
        .RightMargin = CentimetersToPoints(2.54)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.27)
        .FooterDistance = CentimetersToPoints(1.27)
        .PageWidth = CentimetersToPoints(29.7)
        .PageHeight = CentimetersToPoints(21)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = True
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With

'
' SortOutTable Macro

'Set cell Padding

    With Selection.Tables(1)
        .TopPadding = CentimetersToPoints(0.2)
        .BottomPadding = CentimetersToPoints(0.2)
        .LeftPadding = CentimetersToPoints(0.2)
        .RightPadding = CentimetersToPoints(0.2)
        .Spacing = 0
        .AllowPageBreaks = True
        .AllowAutoFit = True
    End With
       
'Set Column Widths

    Dim tbl1 As Table
    Set tbl1 = ActiveDocument.Tables(1)
    tbl1.AllowAutoFit = False
    tbl1.Columns.PreferredWidthType = wdPreferredWidthPoints
    tbl1.Columns(1).PreferredWidth = CentimetersToPoints(4.2)
    tbl1.Columns(2).PreferredWidth = CentimetersToPoints(4.2)
    tbl1.Columns(3).PreferredWidth = CentimetersToPoints(6.5)
    tbl1.Columns(4).PreferredWidth = CentimetersToPoints(10.1)
   

 'Set Border Colours
    Selection.Tables(1).Select
    Options.DefaultBorderColor = 192
        With Selection.Borders(wdBorderTop)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderLeft)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderBottom)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderRight)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderHorizontal)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderVertical)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    

    
'Format font & shading 1st Row
    Selection.Tables(1).Rows(1).Shading.Texture = wdTextureNone
    Selection.Tables(1).Rows(1).Shading.ForegroundPatternColor = wdColorAutomatic
    Selection.Tables(1).Rows(1).Shading.BackgroundPatternColor = -603917569
     With ActiveDocument.Tables(1).Rows(1).Range
        .Font.Bold = True
        .Font.Color = 2950080
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
    End With
       
'Set Row Height
    For Each tbl1 In ActiveDocument.Tables
        tbl1.Rows.HeightRule = wdRowHeightAtLeast
        tbl1.Rows.Height = CentimetersToPoints(0.6)
    Next
       
       
    Selection.Tables(1).Rows.AllowBreakAcrossPages = True
    Selection.Tables(1).Rows.HeadingFormat = False
    
' End of Word formatting
Dim ResultsDirectory1 As String
ResultsDirectory1 = CurrentProject.Path & "\Results\"
    ChangeFileOpenDirectory _
        ResultsDirectory1
    ActiveDocument.SaveAs2 FileName:="Candidates No Longer in Process.docx", FileFormat _
        :=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14

    .Close (Word.WdSaveOptions.wdSaveChanges)
    WordApp1.Quit
    Set WordApp1 = Nothing
 
    End With
' .............................................................................................

'Application.FollowHyperlink ResultsDirectory
    DoCmd.Quit acPrompt
End Sub

Open in new window

correlateAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Barry CunneyCommented:
Hi Correlate,
Instead of referring to ActiveDocument I would try to set an explicit reference to an actual document object when you open each document in turn

Dim WordApp1 As Word.Application
Dim WordDocument1 As Word.Document
Set WordApp1 = CreateObject("Word.Application")
Set WordDocument1 = WordApp1.Documents.Open (OutputFileNotInPlay)
WordApp1.Documents.Save
WordApp1.Visible = True
   
'manipulate RTF doc bit
    With WordDocument1
......
.......
.......

Open in new window

0
correlateAuthor Commented:
Hi,

Thanks for that, I'm still getting the same error but on the next line down, do I need to somehow click on the document through VBA before the next line of code as the doc is opened in a different method?

'Sort Out Page Orientation
        If Selection.PageSetup.Orientation = wdOrientPortrait Then
        Selection.PageSetup.Orientation = wdOrientLandscape
    Else
        Selection.PageSetup.Orientation = wdOrientPortrait
    End If]

Open in new window

0
Barry CunneyCommented:
Hi Correlate
You need continue the reference to the explicit WordDocument1 object throughout the rest of your code and to child objects of this.

The Selection object is not an explicit object as such and does not have a definitive parent

With WordDocument1

           .PageSetup.Orientation = wdOrientPortrait
......

End With

.....

Open in new window

0
Newly released Acronis True Image 2019

In announcing the release of the 15th Anniversary Edition of Acronis True Image 2019, the company revealed that its artificial intelligence-based anti-ransomware technology – stopped more than 200,000 ransomware attacks on 150,000 customers last year.

correlateAuthor Commented:
Hi

Thanks for that,

I'll have to take a look at that in the morning, I started making the amendments but was still getting errors thrown up.  I think I was doing too many with & end withs (basically wrapping up each individual block of code inside a with statement rather than one monster with statement) or should each of these blocks have their own with statement and a load of end withs at the end of the code?
0
Barry CunneyCommented:
Hi Correlate,
The With is just shorthand code, so to speak, to avoid repeating certain references on every line.

As a first version, for clarity, you could leave out using With for the moment.
and just explicitly refer to the full object hierarchy on each line, to fully ensure that you are not referring to any orphan objects

so each line would refer to the document object and all the required child levels
so something like

WordDocument1.PageSetup.Orientation = wdOrientPortrait
....
.....
0
correlateAuthor Commented:
Got it - thanks for that, will give it a go tomorrow
0
correlateAuthor Commented:
Hi

Thanks for this - I have tidied up the code & tested it all for each individual doc - that's all ok, but I'm still getting the same error message when it moves onto the second doc.  This is running on a networked pc, so I tried putting in a pause of 5 seconds - but that has no effect.  I have also tried putting in a kill winword but again, that made little difference.  

So my next thought was can I somehow put in a loop to wait until everything is clear before moving onto the next document?

The code I have so far is here

Private Sub test_Click()
    Dim strFilter As String
    Dim lngFlags As Long
    Dim strStartDir As String
' Lets start the file browse from our current directory
     
    strStartDir = Environ("userProfile") & "\desktop"

    strStartDir = Left(strStartDir, Len(strStartDir) - Len(Dir(strStartDir)))

    
    strFilter = ahtAddFilterItem(strFilter, _
                        "All Files (*.*)", "*.*")
    Me.ImportSpreadsheet = ahtCommonFileOpenSave(InitialDir:=strStartDir, _
                     Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
                     DialogTitle:="Select database")
                     
' Move to right place
Dim FilePathOriginal As String
Dim FilePathDestination As String
FilePathOriginal = Me.ImportSpreadsheet
FilePathDestination = CurrentProject.Path & "\System Files\OriginalSpreadsheet.xlsx"

'check System Files folder exists
Dim fso
Dim fol As String
fol = CurrentProject.Path & "\System Files"
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fol) Then
    fso.CreateFolder (fol)
End If

'check Results folder exists
Dim fso1
Dim fol1 As String
fol1 = CurrentProject.Path & "\Results"
Set fso1 = CreateObject("Scripting.FileSystemObject")
If Not fso1.FolderExists(fol1) Then
    fso1.CreateFolder (fol1)
End If

FileCopy FilePathOriginal, FilePathDestination

'Otput Queries
Dim OutputFileShortlist As String
OutputFileShortlist = CurrentProject.Path & "\System Files\" & "Potential Shortlist.rtf"
DoCmd.OutputTo acOutputQuery, "Candidates No Longer in Process", "RichTextFormat(*.rtf)", OutputFileShortlist, False, "", , acExportQualityPrint


Dim OutputFileNotInPlay As String
OutputFileNotInPlay = CurrentProject.Path & "\System Files\" & "Candidates No Longer in Process.rtf"
DoCmd.OutputTo acOutputQuery, "Candidates No Longer in Process", "RichTextFormat(*.rtf)", OutputFileNotInPlay, False, "", , acExportQualityPrint
    
    
Dim OutputFileResearchStage As String
OutputFileResearchStage = CurrentProject.Path & "\System Files\" & "Candidates at Research Stage.rtf"
DoCmd.OutputTo acOutputQuery, "Research Stage", "RichTextFormat(*.rtf)", OutputFileResearchStage, False, "", , acExportQualityPrint


' .............................................................................................

'Open & Manipulate Potential Shortlist
  
Dim WordApp As Word.Application
Dim WordDocument As Word.Document
Set WordApp = CreateObject("Word.Application")
Set WordDocument = WordApp.Documents.Open(OutputFileShortlist)
WordApp.Documents.Save
WordApp.Visible = True
   

        WordDocument.PageSetup.LineNumbering.Active = False
        WordDocument.PageSetup.Orientation = wdOrientLandscape
        WordDocument.PageSetup.TopMargin = CentimetersToPoints(2.75)
        WordDocument.PageSetup.BottomMargin = CentimetersToPoints(2.25)
        WordDocument.PageSetup.LeftMargin = CentimetersToPoints(2.54)
        WordDocument.PageSetup.RightMargin = CentimetersToPoints(2.54)
        WordDocument.PageSetup.Gutter = CentimetersToPoints(0)
        WordDocument.PageSetup.HeaderDistance = CentimetersToPoints(1.27)
        WordDocument.PageSetup.FooterDistance = CentimetersToPoints(1.27)
        WordDocument.PageSetup.PageWidth = CentimetersToPoints(29.7)
        WordDocument.PageSetup.PageHeight = CentimetersToPoints(21)
        WordDocument.PageSetup.FirstPageTray = wdPrinterDefaultBin
        WordDocument.PageSetup.OtherPagesTray = wdPrinterDefaultBin
        WordDocument.PageSetup.SectionStart = wdSectionNewPage
        WordDocument.PageSetup.OddAndEvenPagesHeaderFooter = False
        WordDocument.PageSetup.DifferentFirstPageHeaderFooter = False
        WordDocument.PageSetup.VerticalAlignment = wdAlignVerticalTop
        WordDocument.PageSetup.SuppressEndnotes = True
        WordDocument.PageSetup.MirrorMargins = False
        WordDocument.PageSetup.TwoPagesOnOne = False
        WordDocument.PageSetup.BookFoldPrinting = False
        WordDocument.PageSetup.BookFoldRevPrinting = False
        WordDocument.PageSetup.BookFoldPrintingSheets = 1
        WordDocument.PageSetup.GutterPos = wdGutterPosLeft

       
'Set Column Widths & Padding

    Dim tbl1a As Table
    Set tbl1a = WordDocument.Tables(1)
    tbl1a.AllowAutoFit = False
    tbl1a.TopPadding = CentimetersToPoints(0.2)
    tbl1a.BottomPadding = CentimetersToPoints(0.2)
    tbl1a.LeftPadding = CentimetersToPoints(0.2)
    tbl1a.RightPadding = CentimetersToPoints(0.2)
    tbl1a.Spacing = 0
    tbl1a.AllowPageBreaks = True
    tbl1a.AllowAutoFit = True
    tbl1a.Columns.PreferredWidthType = wdPreferredWidthPoints
    tbl1a.Columns(1).PreferredWidth = CentimetersToPoints(4.2)
    tbl1a.Columns(2).PreferredWidth = CentimetersToPoints(7)
    tbl1a.Columns(3).PreferredWidth = CentimetersToPoints(10)
    tbl1a.Columns(4).PreferredWidth = CentimetersToPoints(3.8)
    
'Format font & shading 1st Row
    tbl1a.Rows(1).Shading.Texture = wdTextureNone
    tbl1a.Rows(1).Shading.ForegroundPatternColor = wdColorAutomatic
    tbl1a.Rows(1).Shading.BackgroundPatternColor = -603917569
    tbl1a.Rows(1).Range.Font.Bold = True
    tbl1a.Rows(1).Range.Font.Color = 2950080
    tbl1a.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    tbl1a.Rows.AllowBreakAcrossPages = False
    tbl1a.Rows.HeadingFormat = False
       

tbl1a.Borders.InsideLineStyle = wdLineStyleSingle
tbl1a.Borders.OutsideLineStyle = wdLineStyleSingle
tbl1a.Borders.OutsideColor = 192
tbl1a.Borders.InsideColor = 192
       
'Set Row Height
    For Each tbl1a In ActiveDocument.Tables
        tbl1a.Rows.HeightRule = wdRowHeightAtLeast
        tbl1a.Rows.Height = CentimetersToPoints(0.6)
    Next

  

    WordDocument.Close (Word.WdSaveOptions.wdSaveChanges)
    WordApp.Quit
    Set WordApp = Nothing

Sleep 5000
Call KillProcess("winword.exe")

' .............................................................................................

'Open & Manipulate Candidates No Longer in Process

   
Dim WordApp1 As Word.Application
Dim WordDocument1 As Word.Document
Set WordApp1 = CreateObject("Word.Application")
Set WordDocument1 = WordApp1.Documents.Open(OutputFileNotInPlay)
WordApp1.Documents.Save
WordApp1.Visible = True


        WordDocument1.PageSetup.LineNumbering.Active = False
        WordDocument1.PageSetup.Orientation = wdOrientLandscape
        WordDocument1.PageSetup.TopMargin = CentimetersToPoints(2.75)
        WordDocument1.PageSetup.BottomMargin = CentimetersToPoints(2.25)
        WordDocument1.PageSetup.LeftMargin = CentimetersToPoints(2.54)
        WordDocument1.PageSetup.RightMargin = CentimetersToPoints(2.54)
        WordDocument1.PageSetup.Gutter = CentimetersToPoints(0)
        WordDocument1.PageSetup.HeaderDistance = CentimetersToPoints(1.27)
        WordDocument1.PageSetup.FooterDistance = CentimetersToPoints(1.27)
        WordDocument1.PageSetup.PageWidth = CentimetersToPoints(29.7)
        WordDocument1.PageSetup.PageHeight = CentimetersToPoints(21)
        WordDocument1.PageSetup.FirstPageTray = wdPrinterDefaultBin
        WordDocument1.PageSetup.OtherPagesTray = wdPrinterDefaultBin
        WordDocument1.PageSetup.SectionStart = wdSectionNewPage
        WordDocument1.PageSetup.OddAndEvenPagesHeaderFooter = False
        WordDocument1.PageSetup.DifferentFirstPageHeaderFooter = False
        WordDocument1.PageSetup.VerticalAlignment = wdAlignVerticalTop
        WordDocument1.PageSetup.SuppressEndnotes = True
        WordDocument1.PageSetup.MirrorMargins = False
        WordDocument1.PageSetup.TwoPagesOnOne = False
        WordDocument1.PageSetup.BookFoldPrinting = False
        WordDocument1.PageSetup.BookFoldRevPrinting = False
        WordDocument1.PageSetup.BookFoldPrintingSheets = 1
        WordDocument1.PageSetup.GutterPos = wdGutterPosLeft

       
'Set Column Widths & Padding

    Dim tbl1 As Table
    Set tbl1 = WordDocument1.Tables(1)
    tbl1.AllowAutoFit = False
    tbl1.TopPadding = CentimetersToPoints(0.2)
    tbl1.BottomPadding = CentimetersToPoints(0.2)
    tbl1.LeftPadding = CentimetersToPoints(0.2)
    tbl1.RightPadding = CentimetersToPoints(0.2)
    tbl1.Spacing = 0
    tbl1.AllowPageBreaks = True
    tbl1.AllowAutoFit = True
    tbl1.Columns.PreferredWidthType = wdPreferredWidthPoints
    tbl1.Columns(1).PreferredWidth = CentimetersToPoints(4.2)
    tbl1.Columns(2).PreferredWidth = CentimetersToPoints(4.2)
    tbl1.Columns(3).PreferredWidth = CentimetersToPoints(6.5)
    tbl1.Columns(4).PreferredWidth = CentimetersToPoints(10.1)
    
'Format font & shading 1st Row
    tbl1.Rows(1).Shading.Texture = wdTextureNone
    tbl1.Rows(1).Shading.ForegroundPatternColor = wdColorAutomatic
    tbl1.Rows(1).Shading.BackgroundPatternColor = -603917569
    tbl1.Rows(1).Range.Font.Bold = True
    tbl1.Rows(1).Range.Font.Color = 2950080
    tbl1.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    tbl1.Rows.AllowBreakAcrossPages = False
    tbl1.Rows.HeadingFormat = False
       

tbl1.Borders.InsideLineStyle = wdLineStyleSingle
tbl1.Borders.OutsideLineStyle = wdLineStyleSingle
tbl1.Borders.OutsideColor = 192
tbl1.Borders.InsideColor = 192
       
'Set Row Height
    For Each tbl1 In ActiveDocument.Tables
        tbl1.Rows.HeightRule = wdRowHeightAtLeast
        tbl1.Rows.Height = CentimetersToPoints(0.6)
    Next

    


    WordDocument1.Close (Word.WdSaveOptions.wdSaveChanges)
    WordApp1.Quit
    Set WordApp1 = Nothing

Sleep 5000

Call KillProcess("winword.exe")

' .............................................................................................
End Sub

Open in new window

0
RobSampsonCommented:
Hi, with your latest code, what line is the error on, and what are the details of the error?

Regards,

Rob.
0
GrahamSkanRetiredCommented:
correlate,

This question looks identical to the one here:
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_28257196

This is not permitted since it could be used to award more than the 500 permitted maximum points.
 
In the other one, I suggested (amongst other things) that you use the same Winword instance for the whole process.
0
Vadim RappCommented:
I would remove the lines that quit winword application, such as createobject, .quit, and killprocess.

set wa=createobject("word.application")
set mydoc=wa.documents.open (<some file>)
with mydoc
   .<do this>
   .<do that>
   .save
   .close
end with

set mydoc=wa.documents.open(<another file>)
with mydoc
   .<do this>
   .<do that>
   .save
   .close
end with

Where does this code run? in Access, in Word, or elsewhere? in the first code you posted there was docmd, which implied Access, but at the same time you used ActiveDocument, which implied Word.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Nick67Commented:
I'd break stuff up.
When you copy-and-paste large blocks of code, it's time to ask "should this be a separate sub?"

So, one sub to create the files, and call another sub to manipulate them, like this
Private Sub CreateFiles()
Dim strFilter As String
Dim lngFlags As Long
Dim strStartDir As String
' Lets start the file browse from our current directory
 
strStartDir = Environ("userProfile") & "\desktop"
strStartDir = Left(strStartDir, Len(strStartDir) - Len(Dir(strStartDir)))
strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
Me.ImportSpreadsheet = ahtCommonFileOpenSave(InitialDir:=strStartDir, Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, DialogTitle:="Select database")
                     
' Move to right place
Dim FilePathOriginal As String
Dim FilePathDestination As String
FilePathOriginal = Me.ImportSpreadsheet
FilePathDestination = CurrentProject.Path & "\System Files\OriginalSpreadsheet.xlsx"

'check System Files folder exists
Dim fso
Dim fol As String
fol = CurrentProject.Path & "\System Files"
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fol) Then
    fso.CreateFolder (fol)
End If

'check Results folder exists
Dim fso1
Dim fol1 As String
fol1 = CurrentProject.Path & "\Results"
Set fso1 = CreateObject("Scripting.FileSystemObject")
If Not fso1.FolderExists(fol1) Then
    fso1.CreateFolder (fol1)
End If

FileCopy FilePathOriginal, FilePathDestination

'Output Queries
Dim OutputFileShortlist As String
OutputFileShortlist = CurrentProject.Path & "\System Files\" & "Potential Shortlist.rtf"
DoCmd.OutputTo acOutputQuery, "Candidates No Longer in Process", "RichTextFormat(*.rtf)", OutputFileShortlist, False, "", , acExportQualityPrint

Dim OutputFileNotInPlay As String
OutputFileNotInPlay = CurrentProject.Path & "\System Files\" & "Candidates No Longer in Process.rtf"
DoCmd.OutputTo acOutputQuery, "Candidates No Longer in Process", "RichTextFormat(*.rtf)", OutputFileNotInPlay, False, "", , acExportQualityPrint
    
Dim OutputFileResearchStage As String
OutputFileResearchStage = CurrentProject.Path & "\System Files\" & "Candidates at Research Stage.rtf"
DoCmd.OutputTo acOutputQuery, "Research Stage", "RichTextFormat(*.rtf)", OutputFileResearchStage, False, "", , acExportQualityPrint

Call ManipulateFile(OutputFileShortlist)
Call ManipulateFile(OutputFileNotInPlay)
Call ManipulateFile(OutputFileResearchStage)

End Sub

Private Sub ManipulateFile(FilePath As String)
'Open & Manipulate created files
  
Dim WordApp As Word.Application
Dim WordDocument As Word.Document
Set WordApp = CreateObject("Word.Application")
Set WordDocument = WordApp.Documents.Open(FilePath)
WordApp.Documents.Save

'this is good for testing purposes but may give grief if full automation is required
'The visible app sometimes insists on user input, and may not close gracefully by code
WordApp.Visible = True

With WordDocument.PageSetup
    .LineNumbering.Active = False
    .Orientation = wdOrientLandscape
    .TopMargin = CentimetersToPoints(2.75)
    .BottomMargin = CentimetersToPoints(2.25)
    .LeftMargin = CentimetersToPoints(2.54)
    .RightMargin = CentimetersToPoints(2.54)
    .Gutter = CentimetersToPoints(0)
    .HeaderDistance = CentimetersToPoints(1.27)
    .FooterDistance = CentimetersToPoints(1.27)
    .PageWidth = CentimetersToPoints(29.7)
    .PageHeight = CentimetersToPoints(21)
    .FirstPageTray = wdPrinterDefaultBin
    .OtherPagesTray = wdPrinterDefaultBin
    .SectionStart = wdSectionNewPage
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .VerticalAlignment = wdAlignVerticalTop
    .SuppressEndnotes = True
    .MirrorMargins = False
    .TwoPagesOnOne = False
    .BookFoldPrinting = False
    .BookFoldRevPrinting = False
    .BookFoldPrintingSheets = 1
    .GutterPos = wdGutterPosLeft
End With
       
'Set Column Widths & Padding

Dim tbl1a As Table
Set tbl1a = WordDocument.Tables(1)
With tbl1a
    .AllowAutoFit = False
    .TopPadding = CentimetersToPoints(0.2)
    .BottomPadding = CentimetersToPoints(0.2)
    .LeftPadding = CentimetersToPoints(0.2)
    .RightPadding = CentimetersToPoints(0.2)
    .Spacing = 0
    .AllowPageBreaks = True
    .AllowAutoFit = True
    .Columns.PreferredWidthType = wdPreferredWidthPoints
    .Columns(1).PreferredWidth = CentimetersToPoints(4.2)
    .Columns(2).PreferredWidth = CentimetersToPoints(7)
    .Columns(3).PreferredWidth = CentimetersToPoints(10)
    .Columns(4).PreferredWidth = CentimetersToPoints(3.8)

'Format font & shading 1st Row
    .Rows(1).Shading.Texture = wdTextureNone
    .Rows(1).Shading.ForegroundPatternColor = wdColorAutomatic
    .Rows(1).Shading.BackgroundPatternColor = -603917569
    .Rows(1).Range.Font.Bold = True
    .Rows(1).Range.Font.Color = 2950080
    .Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    .Rows.AllowBreakAcrossPages = False
    .Rows.HeadingFormat = False

    .Borders.InsideLineStyle = wdLineStyleSingle
    .Borders.OutsideLineStyle = wdLineStyleSingle
    .Borders.OutsideColor = 192
    .Borders.InsideColor = 192
End With
'Set Row Height
'before you do this you may need
'Set tbl1a = nothing

For Each tbl1a In ActiveDocument.Tables
    tbl1a.Rows.HeightRule = wdRowHeightAtLeast
    tbl1a.Rows.Height = CentimetersToPoints(0.6)
Next

WordDocument.Close (Word.WdSaveOptions.wdSaveChanges)
WordApp.Quit
Set WordApp = Nothing

End Sub

Open in new window


Note that making Word visible may interfere with automation.
Try commenting that line out, if problems persist.

Doing it this way should get Word to exit gracefully when each Call ends --if being visible isn't squirrelling things up.
0
correlateAuthor Commented:
Thank you all - got this sorted now - broke the code into smaller chunks & then opened an instance of word & simply used with statements to move through the various docs & closed word at the end - the main issue I was having was closing word & opening it up again
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.