asked on

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!

GrahamSkan

Is the macro in a Word document or in Access?

I think the we will need to see the code.

Tom Crowfoot

ASKER

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

Tom Crowfoot

ASKER

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

GrahamSkan

What does your KillProcess procedure do?

Gustav Brock

You probably need:

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

and the killprocess should absolutely go away.

/gustav

Tom Crowfoot

ASKER

Cool thanks for that will give it a go in the morning

ASKER CERTIFIED SOLUTION

GrahamSkan

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Tom Crowfoot

ASKER

Brilliant -thank you very much, finally got it to work. Thanks for all your help!