Loop through pages, cut/paste into new document then save new document

[LibrarianBri]

Hello, I have a word document that is around 3000 pages long. I am trying to write a script that will go through the document, cut out the pages I need and paste them into a new document, then save the document with a file name.

I have the following working, but I have to set the start/end page number and file name each time manually.


' works but manually has to be changed
Sub selectpages()


Dim rgePages As Range
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=1
Set rgePages = Selection.Range
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=8
rgePages.End = Selection.Bookmarks("\Page").Range.End
rgePages.Select
Selection.Copy
Selection.Delete
Documents.Add 'Makes a new document
Selection.PasteAndFormat wdPasteDefault 'Pastes in the content
ActiveDocument.SaveAs FileName:="filename.docx"
ActiveDocument.Close

End Sub




What I would like to do is set up a multidimensional array that would have the start page, end page and filename all as elements in the array, but I am unsure how to write the array / call it. The document would be broken up into around 150 different files with anywhere from 10 to 200 pages in each file. Any suggestions on how to modify this to make it work?



Sub ArrayTest()
Dim pgArray(1, 2) As String
Dim rgePages As Range

pgArray(0, 0) = "1"
pgArray(0, 1) = "8"
pgArray(0, 2) = "moduleA.doc"

pgArray(1, 0) = "9"
pgArray(1, 1) = "75"
pgArray(1, 2) = "moduleB.doc"

ubx = UBound(pgArray, 1) + 1

For j = 0 To ubx

Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pgArray(j, 0)
Set rgePages = Selection.Range
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pgArray(j, 1)
rgePages.End = Selection.Bookmarks("\Page").Range.End
rgePages.Select
Selection.Copy
Selection.Delete
Documents.Add 'Makes a new document
Selection.PasteAndFormat wdPasteDefault 'Pastes in the content
ActiveDocument.SaveAs FileName:=pgArray(j, 2)
ActiveDocument.Close
Documents("MainDoc.docx").Activate
Next

End Sub

[gmaxey]

Sub ArrayTest()
Dim pgArray(1, 2) As String
Dim oRng As Range
Dim lngIndex As Long
Dim oDoc As Document
pgArray(0, 0) = "1"
pgArray(0, 1) = "8"
pgArray(0, 2) = "moduleA.doc"
pgArray(1, 0) = "9"
pgArray(1, 1) = "75"
pgArray(1, 2) = "moduleB.doc"
For lngIndex = 0 To UBound(pgArray, 1)
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pgArray(lngIndex, 0)
Set oRng = Selection.Range
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pgArray(lngIndex, 1)
oRng.End = Selection.Bookmarks("\Page").Range.End
oRng.Copy
Set oDoc = Documents.Add 'Makes a new document
oDoc.Range.PasteAndFormat wdPasteDefault 'Pastes in the content
oDoc.SaveAs FileName:=pgArray(oRng, 2)
oDoc.Close
Next
End Sub

[LibrarianBri]

I get a Run-time error '13': type mismatch on

oDoc.SaveAs FileName:=pgArray(oRng, 2)

When I run the code, any idea why?

[gmaxey]

I think oRng should be replaced with lngIndex in that line.