VBA Code to automate running another VBA code

[mpeterson]

Hi All,

I have been running a vba macro which applies html tags on selected items in a text for over two years. Due to the increasing amount of work needed by this code, manual work of running it on a file and saving it has become a very tedious and time consuming task. The number of files that need html tags application is over 15000!!
The VBA macro which I'm using could be found at this link: http://www.vbaexpress.com/forum/showthread.php?51178-Word-macro-to-add-html-tags-to-specific-parsed-phrases
I am in a dire need to automate running that code by another VBA code which should be doing the following:
1. Opening one file.doc at a time from "c:\before_conversion" folder,
2. Running the original code to apply html tags,
3. Saving the converted file in the same name but in another folder named "c:\after_conversion", and then
4. Going for the following file in "before_conversion" folder to do the same three processes till the end of all files in this folder.

Can I get some assistance with this request please?

Very much appreciated.

[gmaxey]

mpeterson,

You did get some assistance! An example of using Dir was found directly adjacent to your last (referenced) post.


Private oDoc As Document
Sub LoopThroughFolder()
Dim strFile As String
Const strPath As String = "c:\before_conversion\" 'the folder with the files
Const strSavePath As String = "c:\after_conversion\"
strFile = Dir$(strPath & "*.do*")
While strFile <> ""
Set oDoc = Documents.Open(strPath & strFile)
ScratchMacro
oDoc.SaveAs2 strSavePath & strFile, , , , False
oDoc.Close
strFile = Dir$()
Wend
End Sub
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim lngIndex As Long
Dim strFind As String
Dim oRng As Word.Range
Dim oRngBox As Word.Range
Dim oSrchRng As Word.Range
Set oRng = oDoc.Range
oRng.Collapse wdCollapseStart
Do
Do
On Error Resume Next
oRng.MoveEnd wdParagraph
If Err.Number <> 0 Then Exit Do
Loop Until oRng.Characters.Last.Next = Chr(13)
On Error GoTo 0
For lngIndex = 5 To oRng.Paragraphs.Count
strFind = oRng.Paragraphs(lngIndex).Range.Text
strFind = Right(strFind, Len(strFind) - InStr(strFind, ".") - 1)
strFind = Left(strFind, Len(strFind) - 1)
Set oSrchRng = oRng.Paragraphs(3).Range
Set oRngBox = oSrchRng.Duplicate
Selection.Find.ClearFormatting
With oSrchRng.Find
.Text = strFind
While .Execute
If oSrchRng.InRange(oRngBox) Then
With oSrchRng
If oSrchRng.Characters.Last.Next = "." Then oSrchRng.MoveEnd wdCharacter, 1
.InsertBefore "<font color = ""#008000"">"
.InsertAfter "</font>"
.Collapse wdCollapseEnd
End With
End If
Wend
End With
Set oSrchRng = oRng.Paragraphs(4).Range
With oSrchRng.Find
.Text = strFind
While .Execute
If oSrchRng.InRange(oRngBox) Then
With oSrchRng
If oSrchRng.Characters.Last.Next = "." Then oSrchRng.MoveEnd wdCharacter, 1
.InsertBefore "<font color = ""#008000"">"
.InsertAfter "</font>"
.Collapse wdCollapseEnd
End With
End If
Wend
End With
Next lngIndex
oRng.Collapse wdCollapseEnd
oRng.MoveStart wdParagraph, 1
Loop Until oRng.End = oDoc.Range.End - 1
End Sub

[mpeterson]

Hi Greg,

Truly, I don't know how to thank you. I actually felt embarrassed when I saw you solved my problem.
Please accept my deep respect and gratitude. Thank you very much.