Save all open documents except intermediate documents in document combine macro

[h2whoa]

Hi all,


I've hit a brick wall, having Frankensteined bits of code. I am not a coder, so I apologise if this is a mess. Basically, the code I currently have will combine the revisions and comments from multiple Word documents in a specified folder into a single document. This is useful if a load of people have sent revisions. The code asks you to give a file name for the merged document, to specify which folder the revisions are in, and a starting document (if you go from blank, everything is marked as a revision).


In this process, a bunch of intermediate files are created and left open, which are the product of iterative combining steps. The code gives users a chance to close all open documents at the end. You can save the changes to all of them before it closes (it will 'merge saved' to these file names). This is so if users have other documents open, they won't lose their work.


However, I don't want it save the iteration files. I'm trying to get the macro to refer to the iteration file path and save without closing if it is the same as the folder with the revised documents. But I am just chasing my tail now. Any help truly appreciated!


The trouble bit of code comes, I think, at what I have designated Line100. Like I say, I don't really know what I'm doing, so I claim no credit for the bits of code that do work! I'm just experimenting.

    Sub BetterMerge2()
 Dim dlgOpen As FileDialog
 Dim SelectedFileItem As String
 Set dlgOpen = Application.FileDialog( _
 FileDialogType:=msoFileDialogOpen)
 With dlgOpen
 If .Show = -1 Then
    SelectedFileItem = .SelectedItems(1)
    Documents.Open (SelectedFileItem)
    Else
    End If
 End With


    Dim iFile As Integer
    Dim sMergePath As String
    Dim strFile As String
    Dim sMergeName As String
    Dim sSave As String
    Dim i As Long
    Dim sClose As String
    Dim sName2 As String, sNamePath2 As String, sFinal2 As String
    Dim sCloseFolder As String
    
       
    sMergeName = InputBox("Filename of merged file")
    If sMergeName = "" Then End
    
    sMergePath = MergeFolder2
    
    If sMergePath = vbNullString Then Exit Sub
    strFile = Dir$(sMergePath & "*.doc*")
    While strFile <> ""
        MergeDocument2 sMergePath & strFile
        i = i + 1
        strFile = Dir$()
    Wend
    
    sSave = sMergePath & "\" & sMergeName
    ActiveDocument.SaveAs FileName:=sSave & ".docx"
    ActiveDocument.Close
    MsgBox ("The code finished merging: " & i & " documents")
    
    If MsgBox("Close All Windows?", vbYesNo) = vbYes Then
     
            If MsgBox("Save All?" & vbNewLine & "Yes will add 'merge saved' to filenames", vbYesNo) = vbYes Then
Line90:
                With Application
                .ScreenUpdating = False
                Do Until .Documents.Count = 0
                DoEvents
                    If .Documents.Count = 0 Then
                        GoTo Line250
                    Else
                        GoTo Line100
                    End If
                Loop
                End With


Line100:
                With Application
                    .ScreenUpdating = False
                With ActiveDocument
                    sCloseFolder = ActiveDocument.Path
                    If sCloseFolder = sMergePath Then
                        GoTo Line110
                    Else
                        GoTo Line200
                    End If
                End With
                End With


Line110:
                With Application
                    .ScreenUpdating = False
                    ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
                GoTo Line90
                End With
                
Line200:
                With ActiveDocument
                sName2 = Left(ActiveDocument.Name, _
                Len(ActiveDocument.Name) - 5) & " merge saved" & ".docx"
                sNamePath2 = ActiveDocument.Path
                sFinal2 = sNamePath2 & "\" & sName2
                    .SaveAs FileName:=sFinal2
                    .Close
                    GoTo Line90
                End With


            Else
                With Application
                .ScreenUpdating = False
                Do Until .Documents.Count = 0
                .Documents(1).Close SaveChanges:=wdDoNotSaveChanges
                Loop
                .Quit SaveChanges:=wdDoNotSaveChanges
                End With
            End If
    End If
Line250:
                Application.Quit SaveChanges:=wdDoNotSaveChanges
End Sub
Sub MergeDocument2(sPath As String)
    Application.ScreenUpdating = False
    ActiveDocument.Merge FileName:=sPath, _
    MergeTarget:=wdMergeTargetSelected, DetectFormatChanges:=True, _
    UseFormattingFrom:=wdFormattingFromPrompt, AddToRecentFiles:=False
End Sub
Function MergeFolder2() As String
    MergeFolder2 = vbNullString
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder of the merge files"
        If .Show = -1 Then
            MergeFolder2 = .SelectedItems(1) & Chr(92)
        End If
    End With
End Function