Merging two MACRO scripts (WORD)
I have two Macro scripts, both are working perfectly individually! But I want to marge them and have 1 script. Basically, I want to save all pages in a WORD document (like 100 pages) as PDF and name each file according to the 3rd line of each page.
The problem is they are both saving a file - one in PDF format and the other in word format...I tried to merge them but everytime something breaks in the middle..
Here are the scripts:
Code:
[COLOR=var(--highlight-keyword)]Sub[/COLOR] SaveAsSeparatePDFs()
[COLOR=var(--highlight-keyword)]Dim[/COLOR] strDirectory [COLOR=var(--highlight-keyword)]As[/COLOR] [COLOR=var(--highlight-literal)]String[/COLOR], strTemp [COLOR=var(--highlight-keyword)]As[/COLOR] [COLOR=var(--highlight-literal)]String[/COLOR], ipgEnd [COLOR=var(--highlight-keyword)]As[/COLOR] [COLOR=var(--highlight-literal)]Integer[/COLOR]
[COLOR=var(--highlight-keyword)]Dim[/COLOR] iPDFnum [COLOR=var(--highlight-keyword)]As[/COLOR] [COLOR=var(--highlight-literal)]Integer[/COLOR], i [COLOR=var(--highlight-keyword)]As[/COLOR] [COLOR=var(--highlight-literal)]Integer[/COLOR]
strTemp = InputBox([COLOR=var(--highlight-variable)]"How many pages is included?"[/COLOR] & vbNewLine & [COLOR=var(--highlight-variable)]"(ex: 60)"[/COLOR])
ipgEnd = [COLOR=var(--highlight-literal)]CInt[/COLOR](strTemp)
strDirectory = Environ([COLOR=var(--highlight-variable)]"USERPROFILE"[/COLOR]) & [COLOR=var(--highlight-variable)]"\Desktop"[/COLOR]
iPDFnum = [COLOR=var(--highlight-namespace)]1[/COLOR]
[COLOR=var(--highlight-keyword)]For[/COLOR] i = [COLOR=var(--highlight-namespace)]1[/COLOR] [COLOR=var(--highlight-keyword)]To[/COLOR] ipgEnd
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
strDirectory & [COLOR=var(--highlight-variable)]"\User--"[/COLOR] & iPDFnum & FirstPara & [COLOR=var(--highlight-variable)]".pdf"[/COLOR], ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=[COLOR=var(--highlight-literal)]False[/COLOR], OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportFromTo, [COLOR=var(--highlight-keyword)]From[/COLOR]:=i, [COLOR=var(--highlight-keyword)]To[/COLOR]:=i + [COLOR=var(--highlight-namespace)]1[/COLOR], Item:=wdExportDocumentContent, _
IncludeDocProps:=[COLOR=var(--highlight-literal)]False[/COLOR], KeepIRM:=[COLOR=var(--highlight-literal)]False[/COLOR], CreateBookmarks:= _
wdExportCreateHeadingBookmarks, DocStructureTags:=[COLOR=var(--highlight-literal)]True[/COLOR], _
BitmapMissingFonts:=[COLOR=var(--highlight-literal)]False[/COLOR], UseISO19005_1:=[COLOR=var(--highlight-literal)]False[/COLOR]
iPDFnum = iPDFnum + [COLOR=var(--highlight-namespace)]1[/COLOR]
i = i + [COLOR=var(--highlight-namespace)]1[/COLOR]
[COLOR=var(--highlight-keyword)]Next[/COLOR] i
[COLOR=var(--highlight-keyword)]End[/COLOR]
[COLOR=var(--highlight-keyword)]End[/COLOR] [COLOR=var(--highlight-keyword)]Sub[/COLOR]
Sub RenameFile()
Dim oSection As Section
Dim r As Range
Dim TempDoc As Document
Dim FirstPara As String
Dim strDirectory As String, strTemp As String, ipgEnd As Integer
Dim iPDFnum As Integer, i As Integer
For Each oSection In ActiveDocument.Sections
Set r = oSection.Range
r.End = r.End - 1
Set TempDoc = Documents.Add
With TempDoc
.Range = r
FirstPara = r.Paragraphs(3).Range.Text
FirstPara = Left(FirstPara, Len(FirstPara) - 1)
.SaveAs FileName:=FirstPara & ".doc"
.Close
End With
Set r = Nothing
Set TempDoc = Nothing
Next
End Sub
