Running a macro on more than one file

  • Thread starter Thread starter djb
  • Start date Start date
D

djb

History ..

I used this group to find a macro that would split a file created from
a mail merge into individual documents (I tried a few that had been
posted here but the one that worked was one that someone had
referenced at the microsoft site).

This work very well - now I have 50 documents. The only thing I need
to do to them is change their page margins. I have recorded a macro
which does it - now I want to run the macro on all the docs without
opening and resaving each one - is this possible?

Many thanks in advance

Deb
 
If your files are all in one folder ...

Dim pFileName as string
Dim pDoc as Word.Document

pFileName = Dir("c:\Myfolder....\*.doc")
Do until len(pFileName ) = 0
Set pDoc = Documents.Open(pFileName)

.... run your macro on pDoc

pDoc.Close SaveChanges:=TRUE
set pDoc = Nothing

pFileName = Dir
Loop

Msgbox "Finished..."
 
OK - I created a macro using below but am not sure how to insert my
macro in and make sense of the path.

Here is your macro, with my macro inserted where you typed "run your
macro on pDoc" .... if I need to move to the vba group, let me know. I
am not very experienced - I just know how to create them and use them,
not how to debug or fine tune them. My macro changes the page margins
and inserts an autotext.

Deb

Sub RunPageMacro()
'
' Macro to change page settings
' Macro created 9/11/2004 by deb with macro from jezebel ms ng
'
Dim pFileName As String
Dim pDoc As Word.Document

pFileName = Dir("C:\Documents and
Settings\Deb\Desktop\camp2005\permission forms\*.doc")
Do Until Len(pFileName) = 0
Set pDoc = Documents.Open(pFileName)

With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(1.5)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2.5)
.RightMargin = CentimetersToPoints(2)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.25)
.FooterDistance = CentimetersToPoints(1.25)
.PageWidth = CentimetersToPoints(21)
.PageHeight = CentimetersToPoints(29.7)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.GutterPos = wdGutterPosLeft
End With
ActiveWindow.ActivePane.SmallScroll Down:=50
Application.DisplayAutoCompleteTips = True
NormalTemplate.AutoTextEntries("SigBox").Insert
Where:=Selection.Range
ActiveDocument.Shapes("Text Box 5").Select

pDoc.Close SaveChanges:=True
Set pDoc = Nothing

pFileName = Dir
Loop

MsgBox "Finished..."
End Sub
 
As with all macros created by recording, your code as a lot of unnecessary
instructions. I've cleaned it up a little, as you'll see. The one problem is
the AutoText insertion. The code you have assumes that scrolling down 50
lines will select the bit of document where you want to insert the AutoText.
ActiveWindow.ActivePane.SmallScroll Down:=50
NormalTemplate.AutoTextEntries("SigBox").Insert Where:=Selection.Range
Click to expand...

If you just want to add your autotext to the end of the document, replace
these two lines with

NormalTemplate.AutoTextEntries("SigBox").Insert
Where:=pDoc.Range(pDoc.Range.End - 1, pDoc.Range.End - 1)
 
The error I get is a runtime error no 5174 at this line of code ...

Set pDoc = Documents.Open(pFileName)

It says it can't find the file and to try another spelling or another
file name then names one of the files in the folder (all the files are
surname then initial eg white_g.doc, smith_j.doc)

Deb
 
The error I get is a runtime error no 5174 at this line of code ...

Set pDoc = Documents.Open(pFileName)

It says it can't find the file and to try another spelling or another
file name then names one of the files in the folder (all the files are
surname then initial eg white_g.doc, smith_j.doc)

Deb
 
Sorry, my mistake. Dir() returns only the name, not the path.

Try this

Const pFolder as string = "C:\Documents and
Settings\Deb\Desktop\camp2005\permission forms\"
:
pFileName = Dir(pFolder & "*.doc")
:
Set pDoc = Documents.Open(pFolder & pFileName)
 
Great. Thanks a lot. Saved me a lot of work.

There is a problem in it somewhere, though. It keeps looping and
doesn't stop - I had it set to make a backup automatically, so that
maybe it. It froze eventually and I killed it, but all the docs are
just the way I wanted it, so thank you very much.

Deb
 
Back
Top