Open and manipulate multiple RTF docs from Access

Dear Experts

I'm really struggling to achieve this ... through Access I want to be able to open a RTF document, run a macro to format it and then save it. Then repeat this procedure on another RTF document.

The problem I'm getting is a runtime error 462 when I'm in the second document (it does open though) The formatting macros are fine (I've even swapped the order around so it does the second doc 1st) It always manages to open the second doc but gets stuck when trying to apply the formatting

So I'm keen to look at a variety of different ways to open & manipulate these documents - any ideas / different methods would be greatfully received, also if you could let me know what references I should be using in the VBA that would be really useful -  I'll try them all!
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.

GrahamSkanRetiredCommented:
Is the macro in a Word document or in Access?

I think the we will need to see the code.
0
correlateAuthor Commented:
It's in access, it was recorded in word initially and then adapted to access (so it didn't refer to active document) - I'm away from the PC for tonight, but could post the code 1st thing in the morning
0
correlateAuthor Commented:
Here is the code I'm using, it tends to get stuck on anything past line 162 ...

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
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

GrahamSkanRetiredCommented:
What does your KillProcess procedure do?
0
Gustav BrockCIOCommented:
You probably need:

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

and the killprocess should absolutely go away.

/gustav
0
correlateAuthor Commented:
Cool thanks for that will give it a go in the morning
0
GrahamSkanRetiredCommented:
I have reorganised your code somewhat.

The formatting has been put into two Subs as they appear to be identical for the two documents. It makes the main code easier to follow.

There doesn't seem to be much point in Quitting the application and then creating a new instance immediately. Also this version will use an existing instance if there is already one.

Setting objects to Nothing doesn't do anything that  doesn't happen automatically.

I have assumed that your KillProcess is trying to do something similar & I can't see any point in the Sleep lines, so they have both been commented out.

Note: I'm afraid that there is too much off-stage to actually test the code here.

Private Sub test_Click()
    Dim strFilter As String
    Dim lngFlags As Long
    Dim strStartDir As String
    Dim WordApp As Word.Application
    Dim WordDocument As Word.Document
    Dim FilePathOriginal As String
    Dim FilePathDestination As String
    Dim fso 'as FileSystemObject
    Dim fol As String
    Dim bNewAppInstance As Boolean

    ' Let's 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
    FilePathOriginal = Me.ImportSpreadsheet
    FilePathDestination = CurrentProject.Path & "\System Files\OriginalSpreadsheet.xlsx"
    
    'check System Files folder exists
    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
    
    On Error Resume Next 'supress error checking for the next line only
    Set WordApp = GetObject(, "Word.Application")
    On Error GoTo 0 're-enable error checking
    If WordApp Is Nothing Then 'no application instance already, so create one
        Set WordApp = CreateObject("Word.Application")
        bNewAppInstance = True
    End If
    
    Set WordDocument = WordApp.Documents.Open(OutputFileShortlist)
    WordApp.Documents.Save '?
    WordApp.Visible = True
    
    FormatDocument WordDocument
    FormatTables WordDocument.Tables(1)
    
    WordDocument.Close (Word.WdSaveOptions.wdSaveChanges)
    
    'Sleep 5000
    'Call KillProcess("winword.exe")
    
    ' .............................................................................................
    
    'Open & Manipulate Candidates No Longer in Process
    
    
    Set WordDocument = WordApp.Documents.Open(OutputFileNotInPlay)
    
    FormatDocument WordDocument
    FormatTables WordDocument.Tables(1)
    
    WordDocument.Close (Word.WdSaveOptions.wdSaveChanges)
    If bNewAppInstance Then
        WordApp.Quit 'only close the application if it was created specially for this macro
    End If
    
    'Set WordApp1 = Nothing 'This code does nothing useful
    'Sleep 5000
    'Call KillProcess("winword.exe")
    
    ' .............................................................................................
End Sub

Sub FormatDocument(wdDoc As Word.Document)
    With wdDoc.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
End Sub

Sub FormatTables(tbl1a As Word.Table)
    Dim tbl As Table
    With tbl1a
        'Set Column Widths & Padding
        .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 for all tables
    For Each tbl In ActiveDocument.Tables
        tbl.Rows.HeightRule = wdRowHeightAtLeast
        tbl.Rows.Height = CentimetersToPoints(0.6)
    Next
End Sub

Open in new window

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
correlateAuthor Commented:
Brilliant -thank you very much, finally got it to work. Thanks for all your help!
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
Visual Basic Classic

From novice to tech pro — start learning today.