microsoft.public.word.vba.general

Thank you very much for your help. I am getting an error message at the line
"Dim fDialog as FileDialog." The error says "Compile Error. User-defined type
not defined." Do you know why I'm getting an error and how I can fix it?

Thanks.

"Graham Mayor" wrote:

> You need something like
>
> Sub PrintHeadings()
>
> ' Creates a new document with Heading XX
> ' style paragraphs only from active document.
> ' User prompted for max level XX.
>
> Dim para As Paragraph, rng As Range
> Dim DocA As Document, DocB As Document
> Dim iLevel As Integer, iMaxLevel As Integer
> Dim myFile As String
> Dim PathToUse As String
> Dim MyDoc As Document
> Dim iFld As Integer
> Dim fDialog As FileDialog
> Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
>
> With fDialog 'Pick folder containing the files
> .Title = "Select Folder containing the documents to be modifed and click
> OK"
> .AllowMultiSelect = False
> .InitialView = msoFileDialogViewList
> If .Show <> -1 Then
> MsgBox "Cancelled By User"
> Exit Sub
> End If
> PathToUse = fDialog.SelectedItems.Item(1)
> If Right(PathToUse, 1) <> "\" Then PathToUse = PathToUse + "\"
> End With
>
> If Documents.Count > 0 Then 'close any open documents
> Documents.Close savechanges:=wdPromptToSaveChanges
> End If
>
> myFile = Dir$(PathToUse & "*.doc")
>
> ' Ask for max level
> iMaxLevel = InputBox("Enter maximum level for Heading style.")
> If iMaxLevel = 0 Then Exit Sub
>
> StatusBar = "Printing headings. Please wait..."
> 'Open the document to collect the data
> Set DocB = Word.Documents.Add '(DocA.AttachedTemplate.name)
> ' Set extra wide page margins
> With DocB.PageSetup
> .TopMargin = InchesToPoints(0.25)
> .BottomMargin = InchesToPoints(0.25)
> .LeftMargin = InchesToPoints(0.25)
> .RightMargin = InchesToPoints(0.25)
> End With
>
> While myFile <> ""
> 'open the document for processing
> Set MyDoc = Documents.Open(PathToUse & myFile)
> Set DocA = ActiveDocument
>
> Set rng = DocB.Range
>
> For Each para In DocA.Paragraphs
> DoEvents
> iLevel = 0
> ' Check for Heading style
> If para.Format.Style Like "Heading [0-9]" Then
>
> iLevel = Val(Mid(para.Format.Style, 8))
> ' Check for acceptable level
> If iLevel > 0 And iLevel <= iMaxLevel Then
> rng.Collapse wdCollapseEnd
> rng.Text = String(iLevel - 1, vbTab) & _
> Format(iLevel) & ") " & para.Range.Text
> End If
>
> End If
> Next para
>
> ' Delete any annoying page breaks
> rng = Replace(rng, "^m", "")
>
> DocA.Close savechanges:=wdDoNotSaveChanges
> Set DocA = Nothing
>
> GetNextDoc:
> myFile = Dir$()
> Wend
> 'Save target doc
> DocB.Save
> Set DocB = Nothing
> ' Tell user when done
> MsgBox "Done creating new document with headings only."
>
> End Sub
>
>
> --
> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
> Graham Mayor - Word MVP
>
> My web site www.gmayor.com
> Word MVP web site http://word.mvps.org
> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>
> jkmar5 wrote:
> > I need a macro that opens all of the word documents in specific
> > folder, extracts the document headings (what you see in the outline
> > view) and pastes all of the headings into a new document. I have a
> > macro that extracts the headings (see below).
> >
> > The problem is, I have to run this macro on each file individually
> > and it puts the headings in a separate document for each file. I
> > would like to have one document with all of the headings from all of
> > the files, one right after each other. I've never been able to figure
> > out how to write macros that run through all the files in a folder.
> > If you have any suggestions, I would really appreciate your help.
> > Thank you.
> >
> > Sub PrintHeadings()
> >
> > ' Creates a new document with Heading XX
> > ' style paragraphs only from active document.
> > ' User prompted for max level XX.
> >
> > Dim para As Paragraph, rng As Range
> > Dim DocA As Document, DocB As Document
> > Dim iLevel As Integer, iMaxLevel As Integer
> >
> > ' Ask for max level
> > iMaxLevel = InputBox("Enter maximum level for Heading style.")
> > If iMaxLevel = 0 Then Exit Sub
> >
> > StatusBar = "Printing headings. Please wait..."
> >
> > Set DocA = ActiveDocument
> >
> > ' Create new document
> > Set DocB = Word.Documents.Add(DocA.AttachedTemplate.Name)
> >
> > ' Set extra wide page margins
> > With DocB.PageSetup
> > .TopMargin = InchesToPoints(0.25)
> > .BottomMargin = InchesToPoints(0.25)
> > .LeftMargin = InchesToPoints(0.25)
> > .RightMargin = InchesToPoints(0.25)
> > End With
> >
> > Set rng = DocB.Range
> >
> > For Each para In DocA.Paragraphs
> > DoEvents
> > iLevel = 0
> >
> > ' Check for Heading style
> > If para.Format.Style Like "Heading [0-9]" Then
> >
> > iLevel = Val(Mid(para.Format.Style, 8))
> > ' Check for acceptable level
> > If iLevel > 0 And iLevel <= iMaxLevel Then
> > rng.Collapse wdCollapseEnd
> > rng.Text = String(iLevel - 1, vbTab) & _
> > Format(iLevel) & ") " & para.Range.Text
> > End If
> >
> > End If
> > Next para
> >
> > ' Delete any annoying page breaks
> > Selection.Find.ClearFormatting
> > Selection.Find.Replacement.ClearFormatting
> > With Selection.Find
> > .Text = "^m"
> > .Replacement.Text = ""
> > .Forward = True
> > .Wrap = wdFindAsk
> > .Format = False
> > .MatchCase = False
> > .MatchWholeWord = False
> > .MatchWildcards = False
> > .MatchSoundsLike = False
> > .MatchAllWordForms = False
> > End With
> > Selection.Find.Execute replace:=wdReplaceAll
> >
> > ' Tell user when done
> > MsgBox "Done creating new document with headings only."
> >
> > End Sub
>
>
>