Discussion:
Script
(too old to reply)
George Spiro
2006-11-10 15:29:05 UTC
Permalink
Hi,

I am totally worthless in Scripting/VBS I am wondering if someone would be
able to but these 2 scripts togheter.

1st Script:

Public Sub BatchTEST2()

Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
Dim i As Long

PathToUse = "C:\Test\"

'Error handler to handle error generated whenever
'the FindReplace dialog is closed

On Error Resume Next

'Close all open documents before beginning

Documents.Close SaveChanges:=wdPromptToSaveChanges

'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document

FirstLoop = True

'Set the directory and type of file to batch process

With Application.FileSearch
.NewSearch
.LookIn = PathToUse
.SearchSubFolders = True
.FileName = "*.rtf"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles

If .Execute() Then

For i = 1 To .FoundFiles.Count

'Open document
Set myDoc = Documents.Open(.FoundFiles(i))

If FirstLoop Then

'display dialog on first loop only

Dialogs(wdDialogEditReplace).Show

FirstLoop = False

Response = MsgBox("Do you want to process " & _
"the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub

Else

'On subsequent loops (files), a ReplaceAll is
'executed with the original settings and without
'displaying the dialog box again

With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With

End If

'Close the modified document after saving changes
myDoc.Close SaveChanges:=wdSaveChanges

Next i

End If

End With

End Sub

Script 2:

Sub GOODONE()
'
' GOODONE Macro
'
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.5)
.LeftMargin = InchesToPoints(0.5)
.RightMargin = InchesToPoints(0.5)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
Selection.WholeStory
Selection.Font.Name = "Courier New"
Selection.Font.Size = 8
End Sub

Option Explicit

Thanks alot,

George S.
Doug Robbins - Word MVP
2006-11-11 00:38:39 UTC
Permalink
It's probably easier if you tell us what it is intended to do rather than
force us to have to deduce that by interpreting your code.
--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
Post by George Spiro
Hi,
I am totally worthless in Scripting/VBS I am wondering if someone would be
able to but these 2 scripts togheter.
Public Sub BatchTEST2()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
Dim i As Long
PathToUse = "C:\Test\"
'Error handler to handle error generated whenever
'the FindReplace dialog is closed
On Error Resume Next
'Close all open documents before beginning
Documents.Close SaveChanges:=wdPromptToSaveChanges
'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document
FirstLoop = True
'Set the directory and type of file to batch process
With Application.FileSearch
.NewSearch
.LookIn = PathToUse
.SearchSubFolders = True
.FileName = "*.rtf"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() Then
For i = 1 To .FoundFiles.Count
'Open document
Set myDoc = Documents.Open(.FoundFiles(i))
If FirstLoop Then
'display dialog on first loop only
Dialogs(wdDialogEditReplace).Show
FirstLoop = False
Response = MsgBox("Do you want to process " & _
"the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub
Else
'On subsequent loops (files), a ReplaceAll is
'executed with the original settings and without
'displaying the dialog box again
With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With
End If
'Close the modified document after saving changes
myDoc.Close SaveChanges:=wdSaveChanges
Next i
End If
End With
End Sub
Sub GOODONE()
'
' GOODONE Macro
'
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.5)
.LeftMargin = InchesToPoints(0.5)
.RightMargin = InchesToPoints(0.5)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
Selection.WholeStory
Selection.Font.Name = "Courier New"
Selection.Font.Size = 8
End Sub
Option Explicit
Thanks alot,
George S.
Loading...