Results 1 to 3 of 3

How do I sort files before Merging in Word? using VBA macros

Threaded View

  1. #1
    Registered User
    Join Date
    09-10-2010
    Location
    Connecticut, USA
    MS-Off Ver
    Excel 2007
    Posts
    11

    How do I sort files before Merging in Word? using VBA macros

    I have a macro where I merge all RTF (or doc) files in a folder into one word document and create a Table of Contents. But I am trying to figure how to get it to sort before merging.

    So my files are label as:

    Output 01 - XXXX.rtf
    Output 02 - YYYY.rtf
    Output 03 - ZZZZ.rtf
    ....
    Output 09 - AAAA.rtf

    So I have created this macro to merge all my RTF files in a folder together. But it seem to merge it out of order. With the code I posted below, it copies in this order: 09,08,07,01,02,03,05,06,04... When I actually want it to copy the file in numerical order, 01,02,03,04,05,06,07,08,09. So what can I add on to this code to get it to do that?

    Overall, I am hoping this macro can merge any number of outputs, since depending on the project the number of outputs varies. The first part of the file name is always the same with exception of the numbering (Output XX).


    Sub merge()
    Dim fich As String
      fich = InputBox("Path where the outputs are")
      
    Dim ext As String
      ext = InputBox("Filename extension (rtf or doc)")
      
    Dim Totfich As String
    Dim Name As Variant
      ChDrive (fich)
      ChDir (fich)
      Totfich = fich & "\"
      Name = Dir$(Totfich & "*." & ext)
       
    Do While Name <> ""
        Documents.Open FileName:=Name
        
        Selection.WholeStory
        Selection.Copy
        
        Documents(2).Activate
        Selection.Paste
        Documents(1).Activate
        ActiveDocument.Close False
    
        Name = Dir()
        If Name <> "" Then Selection.InsertBreak Type:=wdSectionBreakNextPage
    
    Loop
    
    
    Dim Int_Tableau As Integer
    Dim Ligne As Integer
       For Int_Tableau = 1 To ActiveDocument.Tables.Count
            ActiveDocument.Tables(Int_Tableau).Cell(1, 1).Select
            Options.DefaultBorderLineWidth = wdLineWidth075pt
            With Selection.Cells
            If Selection.Style = "wdStyleHeading1" Then
                ActiveDocument.Tables(Int_Tableau).Select
                With Selection.Borders(wdBorderBottom)
                    .LineStyle = Options.DefaultBorderLineStyle
                    .LineWidth = Options.DefaultBorderLineWidth
                    .Color = Options.DefaultBorderColor
                End With
            End If
            End With
            For Ligne = 1 To ActiveDocument.Tables(Int_Tableau).Rows.Count
                If ActiveDocument.Tables(Int_Tableau).Columns.Count = 1 Then
                     ActiveDocument.Tables(Int_Tableau).Cell(Ligne, 1).Select
                     With Selection.Cells
                     If Selection.Style = ActiveDocument.Styles(wdStyleHeading1) Or Selection.Style = ActiveDocument.Styles(wdStyleHeading2) Or Selection.Style = ActiveDocument.Styles(wdStyleHeading3) Or Selection.Style = ActiveDocument.Styles(wdStyleHeading4) Or Selection.Style = ActiveDocument.Styles(wdStyleHeading5) Or Selection.Style = ActiveDocument.Styles(wdStyleHeading6) Or Selection.Style = ActiveDocument.Styles(wdStyleHeading7) Or Selection.Style = ActiveDocument.Styles(wdStyleHeading8) Or Selection.Style = ActiveDocument.Styles(wdStyleHeading9) Then
                         If Selection.PageSetup.Orientation = wdOrientPortrait Then Selection.Columns.Width = CentimetersToPoints(19.8)
                         If Selection.PageSetup.Orientation = wdOrientLandscape Then Selection.Columns.Width = CentimetersToPoints(28.5)
                     End If
                     End With
                 End If
            Next
       Next
                
    Selection.GoTo What:=wdPage, Count:=2
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeParagraph
    
    With ActiveDocument
            .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
                True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
                LowerHeadingLevel:=9, IncludePageNumbers:=True, AddedStyles:="", _
                UseHyperlinks:=True, HidePageNumbersInWeb:=True
            .TablesOfContents(1).TabLeader = wdTabLeaderDots
            .TablesOfContents.Format = wdIndexIndent
    End With
    
    MsgBox ("Don't forget to check the document and to save it!")
    
    End Sub
    Last edited by pennywaltz; 10-25-2014 at 08:42 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Replies: 3
    Last Post: 03-03-2013, 12:25 PM
  2. [SOLVED] Repeat macros in a loop and save as word files
    By amanduggal in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 06-07-2012, 08:39 AM
  3. Merging two files together based on col common to both files
    By welchs101 in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 07-05-2011, 01:06 PM
  4. Replies: 5
    Last Post: 02-17-2010, 02:02 PM
  5. Merging into Word (not all files)
    By sanya33 in forum Word Formatting & General
    Replies: 1
    Last Post: 08-30-2009, 11:34 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1