vba newb problem

[AHKpie]

Hello dear VBA programmers,

If I execute the next Macro1 in the document I am working in, I get the index I want printed in the same document.
What codes do I have to add if I want to select and copy only the index?
(The printed index is good but I want paste the result in a new empty document)
Many thanks in advance.

Sub Macro1()
ActiveDocument.TablesOfContents.Add Range:=Selection.Range, _
RightAlignPageNumbers:=True, _
UseHeadingStyles:=True, _
UpperHeadingLevel:=1, _
LowerHeadingLevel:=5, _
IncludePageNumbers:=True, _
AddedStyles:="", _
UseHyperlinks:=True, _
HidePageNumbersInWeb:=True, _
UseOutlineLevels:=True
End Sub

[gmayor]

The following should work

Sub Macro2()
    With ActiveDocument
        'insert the TOC
        .TablesOfContents.Add _
                Range:=Selection.Range, _
                RightAlignPageNumbers:=True, _
                UseHeadingStyles:=True, _
                UpperHeadingLevel:=1, _
                LowerHeadingLevel:=5, _
                IncludePageNumbers:=True, _
                AddedStyles:="", _
                UseHyperlinks:=True, _
                HidePageNumbersInWeb:=True, _
                UseOutlineLevels:=True
        'select the TOC
        .TablesOfContents.Item(1).Range.Select
        'Unlink the TOC field
        Selection.Fields.Unlink
        'Copy the unlinked TOC
        Selection.Copy
        'Undo the unlinking to restore the TOC field
        ActiveDocument.Undo 1
        'Next line is optional
        '.TablesOfContents.Item(1).Range.Delete
    End With
    MsgBox "TOC Copied to clipboard"
End Sub

[AHKpie]

Thank you very much Gmayor!

The script works perfectly and now I think I understand VBA code a little bit better thanks to your comment attached!

Have a nice day Gmayor!!

[AHKpie]

Dear programmers,

I found a very nice script developed bij Macropod (I named that macro OneFolderbatch). That script can execute find and replace function (see Macro12) in every document in One selected folder.
If I execute Macro2 manually (while that document opened) it works as I want but if I Call it in Onefolderbatch Macro2 or Macro3, I dont get the result of Macro2.
What codes do i have to change and add to my Macro2 or Macro3 so it works with OneFolderbatch?

Many many thanks in advance!

Sub OneFolderbatch()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  'Next line you can adapt the Macro to be executed for every document in a single folder
  Call Macro12(wdDoc)
  With wdDoc
    .SaveAs2 FileName:=strFolder & "\" & Split(strFile, ".")(0) & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
 
Sub Macro2()
    With ActiveDocument
        'insert the TOC
        .TablesOfContents.Add _
                Range:=Selection.Range, _
                RightAlignPageNumbers:=True, _
                UseHeadingStyles:=True, _
                UpperHeadingLevel:=1, _
                LowerHeadingLevel:=5, _
                IncludePageNumbers:=True, _
                AddedStyles:="", _
                UseHyperlinks:=True, _
                HidePageNumbersInWeb:=True, _
                UseOutlineLevels:=True
        'select the TOC
        .TablesOfContents.Item(1).Range.Select
        ''Unlink the TOC field
        'Selection.Fields.Unlink
        'Copy the unlinked TOC
        Selection.Copy
        'Undo the unlinking to restore the TOC field
        ActiveDocument.Undo 1
        'Next line is optional
        '.TablesOfContents.Item(1).Range.Delete
        Selection.WholeStory
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.PasteAndFormat (wdFormatOriginalFormatting)
    End With
    
End Sub

Sub Macro3(wdDoc As Document)
  With wdDoc
    With ActiveDocument
        'insert the TOC
        .TablesOfContents.Add _
                Range:=Selection.Range, _
                RightAlignPageNumbers:=True, _
                UseHeadingStyles:=True, _
                UpperHeadingLevel:=1, _
                LowerHeadingLevel:=5, _
                IncludePageNumbers:=True, _
                AddedStyles:="", _
                UseHyperlinks:=True, _
                HidePageNumbersInWeb:=True, _
                UseOutlineLevels:=True
        'select the TOC
        .TablesOfContents.Item(1).Range.Select
        ''Unlink the TOC field
        'Selection.Fields.Unlink
        'Copy the unlinked TOC
        Selection.Copy
        'Undo the unlinking to restore the TOC field
        ActiveDocument.Undo 1
        'Next line is optional
        '.TablesOfContents.Item(1).Range.Delete
        Selection.WholeStory
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.PasteAndFormat (wdFormatOriginalFormatting)
    End With
  End With
End Sub

Sub Macro12(wdDoc As Document)
'
' Macro12 Macro
'
'
  With wdDoc
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Text = "a"
      .Replacement.Text = "BBBBB"
      .Execute Replace:=wdReplaceAll
    End With
  End With
End Sub

[AHKpie]

Respectable programmers,

I think I have found the solution.
How nice software programming is if you understand what you are doing. Or at least if you think you understand what you are doing.

Have a nice day and thank you for reading my posts.

[AHKpie]

I solved my problem of not working macro by simplyfing Paul Edsteins script into this:

Sub Simplify()
Dim file
Dim path As String


'YOU MUST EDIT THIS. Put here the files you want to change with your macro.
path = "c:\test\"


file = Dir(path & "*.*")
Do While file <> ""
Documents.Open FileName:=path & file

' This is the call to the macro you want to run on each file in the folder
Call Macro2

' Saves the file
ActiveDocument.Save
ActiveDocument.Close
' set file to next in Dir
file = Dir()
Loop
End Sub