Hi,
Question 1: I'm working on combining some of the macros that all of you have provided/helped me with (thank you again Greg and Paul
). I've tried adding code to Sub BulkFindReplace (code posted below) so that it will apply the following formatting to all the word docs (.docx) in the folder:
Align "left"
Arial Font
size 11
I've tried putting the code in multiple places using wdDoc and range. I was able to make it work a couple times but then couldn't replicate it. I don't understand why it would work once and then not again.
I've used the following:
Code:
Selection.WholeStory
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.Font.Size = 11
Selection.Font.Name = "Arial"
Question 2: Also, if I do decide to turn track changes on for a folder of .docx folders (MS Word 2007) how would I do that? Again, I was able to make it work a few times, I'm assuming the "activeDocument" part is what prevents it from applying track changes to all the documents. The code I wrote either didn't work again or didn't work on all of them.
Question 3:
Code:
'Add to Student ID
.Text = "SID[:][ ][ ]{1,2}[0-9]{10}"
.Replacement.Text = "^& (Approved: / / )"
.Execute Replace:=wdReplaceAll
When I run the above section in the other
macro it works great but when I add it to Sub BulkFindReplace below it goes crazy. By crazy I mean it adds the "(Approved: / / )" part about twenty times. In keeping with my theme thus far, I can make it work "crazy" or not at all????
Please help, I'm thoroughly and completely confused.
Code:
Sub BulkFindReplace()
Application.ScreenUpdating = True
Dim strFolder As String, strFile As String, wdDoc As Document
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long, Rslt
StrWkBkNm = "C:\Documents" & "\MACRO.xls"
StrWkSht = "Sheet1"
If Dir(StrWkBkNm) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
Exit Sub
End If
'Get the folder to process
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
' Record that we've started Excel.
bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
'Hide our Excel session
If bStrt = True Then .Visible = False
For Each xlWkBk In .Workbooks
If xlWkBk.FullName = StrWkBkNm Then ' It's open
Set xlWkBk = xlWkBk
bFound = True
Exit For
End If
Next
' If not open by the current user.
If bFound = False Then
' Check if another user has it open.
If IsFileLocked(StrWkBkNm) = True Then
' Report and exit if true
MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
If bStrt = True Then .Quit
Exit Sub
End If
' The file is available, so open it.
Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
If xlWkBk Is Nothing Then
MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
If bStrt = True Then .Quit
Exit Sub
End If
End If
' Process the workbook.
With xlWkBk.Worksheets(StrWkSht)
' Find the last-used row in column A.
' Add 1 to get the next row for data-entry.
iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
' Output the captured data.
For i = 1 To iDataRow
' Skip over empty fields to preserve the underlying cell contents.
If Trim(.Range("A" & i)) <> vbNullString Then
xlFList = xlFList & "|" & Trim(.Range("A" & i))
xlRList = xlRList & "|" & Trim(.Range("B" & i))
End If
Next
End With
If bFound = False Then xlWkBk.Close False
If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
' Process each document in the folder
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
' Process each word doc from the F/R List
For i = 1 To UBound(Split(xlFList, "|"))
With wdDoc.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
.Text = Split(xlFList, "|")(i)
.Replacement.Text = Split(xlRList, "|")(i)
.Execute Replace:=wdReplaceAll
End With
End With
' Add "-" to IDs, Add “(Approved: / / )”, Change Dates to Long Format
With wdDoc.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
'Add to SID
.Text = "SID[:][ ][ ]{1,2}[0-9]{10}"
.Replacement.Text = "^& (Approved: / / )"
.Execute Replace:=wdReplaceAll
'Fix IDs Part 1
.Text = "(ID[:][ ][ ]{1,2}[0-9]{2})([0-9]{7})"
.Replacement.Text = "\1-\2"
.Execute Replace:=wdReplaceAll
'Fix IDs Part 2
.Text = "(ID[ ]{1,2}[0-9]{2})([0-9]{7})"
.Replacement.Text = "\1-\2"
.Execute Replace:=wdReplaceAll
'Fix Date ranges
.Text = "[0-9]{1,2}/[0-9]{1,2}/[0-9]{4}-[0-9]{1,2}/[0-9]{1,2}/[0-9]{4}"
.Replacement.Text = ""
.Execute
End With
Do While .Find.Found
StrTxt = Format(Trim(Split(.Text, "-")(0)), "MMMM D, YYYY")
Select Case Trim(LCase(.Words.First.Previous.Previous.Words.First))
Case "between": StrTxt = StrTxt & " and "
Case "from": StrTxt = StrTxt & " to "
Case "of": StrTxt = StrTxt & " through "
End Select
StrTxt = StrTxt & Format(Trim(Split(.Text, "-")(1)), "MMMM D, YYYY")
.Text = StrTxt
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
'Close the document
wdDoc.Close SaveChanges:=True
'Get the next document
strFile = Dir()
Wend
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
Function IsFileLocked(strFileName As String) As Boolean
On Error Resume Next
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
IsFileLocked = Err.Number
Err.Clear
End Function
Thank you (again) for your time.
-Donna