Dear programmers,
I found a very nice script developed bij Macropod (I named that macro OneFolderbatch). That script can execute find and replace function (see Macro12) in every document in One selected folder.
If I execute Macro2 manually (while that document opened) it works as I want but if I Call it in Onefolderbatch Macro2 or Macro3, I dont get the result of Macro2.
What codes do i have to change and add to my Macro2 or Macro3 so it works with OneFolderbatch?
Many many thanks in advance!
Code:
Sub OneFolderbatch()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
'Next line you can adapt the Macro to be executed for every document in a single folder
Call Macro12(wdDoc)
With wdDoc
.SaveAs2 FileName:=strFolder & "\" & Split(strFile, ".")(0) & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
strFile = Dir()
Wend
Set wdDoc = Nothing
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
Sub Macro2()
With ActiveDocument
'insert the TOC
.TablesOfContents.Add _
Range:=Selection.Range, _
RightAlignPageNumbers:=True, _
UseHeadingStyles:=True, _
UpperHeadingLevel:=1, _
LowerHeadingLevel:=5, _
IncludePageNumbers:=True, _
AddedStyles:="", _
UseHyperlinks:=True, _
HidePageNumbersInWeb:=True, _
UseOutlineLevels:=True
'select the TOC
.TablesOfContents.Item(1).Range.Select
''Unlink the TOC field
'Selection.Fields.Unlink
'Copy the unlinked TOC
Selection.Copy
'Undo the unlinking to restore the TOC field
ActiveDocument.Undo 1
'Next line is optional
'.TablesOfContents.Item(1).Range.Delete
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End With
End Sub
Sub Macro3(wdDoc As Document)
With wdDoc
With ActiveDocument
'insert the TOC
.TablesOfContents.Add _
Range:=Selection.Range, _
RightAlignPageNumbers:=True, _
UseHeadingStyles:=True, _
UpperHeadingLevel:=1, _
LowerHeadingLevel:=5, _
IncludePageNumbers:=True, _
AddedStyles:="", _
UseHyperlinks:=True, _
HidePageNumbersInWeb:=True, _
UseOutlineLevels:=True
'select the TOC
.TablesOfContents.Item(1).Range.Select
''Unlink the TOC field
'Selection.Fields.Unlink
'Copy the unlinked TOC
Selection.Copy
'Undo the unlinking to restore the TOC field
ActiveDocument.Undo 1
'Next line is optional
'.TablesOfContents.Item(1).Range.Delete
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End With
End With
End Sub
Sub Macro12(wdDoc As Document)
'
' Macro12 Macro
'
'
With wdDoc
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Text = "a"
.Replacement.Text = "BBBBB"
.Execute Replace:=wdReplaceAll
End With
End With
End Sub