Calling Sub Routine for Formatting recently Created Word Document

[rpb925]

Hi All,


So I have a database which I push a button on and it opens word and puts heaps of data into. However access text fields don't allow formatting so I've set up my own formatting in a way by putting in key words such as , <bold>I want this text bold<bold/>. At I wish to run a sub routine to do this formatting and then delete the traces ie the text <bold> and <bold/>. I have something already but I believe I am using the .selection method which I shouldn't be and I'm not sure what variables I have to define in the sub routine.

Here is the background of the Main routine

Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Dim Tbl As Word.Table

'Open Word
  Set wdApp = CreateObject("Word.Application")
  With wdApp
    .Visible = True
    .ScreenUpdating = False
'Create a new document
    Set wdDoc = .Documents.Add
    With wdDoc
‘Here I do lots and lots of stuff and a whole heap of texts gets inserted from a database made possible with help from Paul
‘HERE IS WHERE I WANT TO CALL FORMATTING SUB ROUTINE
?Call IRDEFormat()?
.SaveAs CurrentProject.Path & "\TestDoc.doc"
'end with doc
End With
    .ScreenUpdating = True

'end with objword
  End With
Set wdRng = Nothing: Set wdTbl = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

Ok Now for IRDEFormat which is where I have my problems. I think there are some fundamental mistakes guidance would be heaven sent. Background is I want it to look for
<italics> and <italics/> format in between and then delete them
<bold> and <bold/> format in between and then delete them
<indent> and <indent/> format indentation in between then delete them

Not so good code is below. It seems like alot but it's repetitive.

Sub IRDEFormat()

Dim wdApp As Word.Application

'INDENT

'Format Word Document
With wdApp

'Move selectiion to start of document
.Selection.HomeKey wdStory

'To ensure that formatting isn't included as criteria in a find or replace operation, use this method before carrying out the operation
.Selection.Find.ClearFormatting

End With

'Find <indent> set range at <indent/>
With wdApp.Selection.Find

'expression .Execute(FindText, MatchCase, MatchWholeWord, MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward, Wrap, Format, ReplaceWith, Replace, MatchKashida, MatchDiacritics, MatchAlefHamza, MatchControl)
Do While .Execute(FindText:="<indent>", Forward:=True, MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False) = True
Set myrange = wdApp.Selection.Range 'Setting property of range
myrange.End = wdApp.ActiveDocument.Range.End 'Set Range to rest of Document
'Instr Returns an integer specifying the start position of the first occurrence of one string within another.
myrange.End = myrange.Start + InStr(myrange, "<indent/>")
myrange.Select

'with range make formatting changes

    With wdApp.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.LeftIndent = wdApp.CentimetersToPoints(1)
.FirstLineIndent = wdApp.CentimetersToPoints(-1)
    End With
wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1

'Loop to next

Loop
End With

'BOLD

'Restart at beggining

With wdApp
.Selection.HomeKey wdStory
.Selection.Find.ClearFormatting

End With

'Define Range

With wdApp.Selection.Find
Do While .Execute(FindText:="<bold>", Forward:=True, MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False) = True
Set myrange = wdApp.Selection.Range
myrange.End = wdApp.ActiveDocument.Range.End
myrange.End = myrange.Start + InStr(myrange, "<bold/>")
myrange.Select

'format

    With wdApp.Selection.Font
.Bold = True
    End With

wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1

'Loop to next
Loop
End With

'ITALICS

With wdApp
.Selection.HomeKey wdStory
.Selection.Find.ClearFormatting

End With

'Define Range

With wdApp.Selection.Find
Do While .Execute(FindText:="<italics>", Forward:=True, MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False) = True
Set myrange = wdApp.Selection.Range
myrange.End = wdApp.ActiveDocument.Range.End
myrange.End = myrange.Start + InStr(myrange, "<italics/>")
myrange.Select

'format

    With wdApp.Selection.Font
.Italic = True
    End With


wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1

'Loop to next
Loop
End With

'Delete formating symbols

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<indent>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=False, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
 With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<indent/>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<bold>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
 With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<bold/>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<italics>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
 With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<italics/>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
 With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<tab>"
    .Replacement.ClearFormatting
    .Replacement.Text = vbTab
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
 End Sub

Cheers Ron