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

[macropod]

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!

To obviate any problems with users losing work in files they already have open, you could have your code create a new Word instance, which you can quit when you're done. As for your intermediate files, you should close each of these as you finish with them. Alternatively, save your combined document, then close all open documents in your new Word session before quitting it.

[h2whoa]

Thanks for this Paul. As I'm a complete derp with these things, how would I go about modifying the code to do implement your solution? Really appreciate the help.

[macropod]

Perhaps something like:

Sub CompareDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Dim wdApp As New Word.Application, wdDoc As Word.Document
With wdApp
  .Visible = False
  .ScreenUpdating = False
  With .Dialogs(wdDialogFileOpen)
    .Name = strFolder
    If .Show = -1 Then
      Set wdDoc = wdApp.ActiveDocument
    Else
      MsgBox "No source file selected. Exiting", vbExclamation
      Exit Sub
    End If
  End With
  strDocNm = wdDoc.FullName
  strFile = Dir(strFolder & "\*.doc", vbNormal)
  While strFile <> ""
    If strFolder & "\" & strFile <> strDocNm Then
      wdDoc.Merge FileName:=strFolder & "\" & strFile, _
        MergeTarget:=wdMergeTargetCurrent, DetectFormatChanges:=True, _
        UseFormattingFrom:=wdFormattingFromCurrent, AddToRecentFiles:=False
    End If
    strFile = Dir()
  Wend
  wdDoc.Close SaveChanges:=True
  .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing
Documents.Open FileName:=strDocNm, ReadOnly:=False, AddToRecentFiles:=False, Visible:=True
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

After processing is complete, the comparison document is saved, then re-opened in the user's original Word session.

[h2whoa]

YOU, SIR, are an absolute bloody genius!

Thank so much for this! Works like a dream. Really appreciate your help. Can't thank you enough.

[h2whoa]

Sorry. One last request. Is it possible to change it so that the final file is saved with a slightly different filename (i.e. adding "merged" to the filename)? Thank you.

[h2whoa]

Ah ha! I think I managed it!

Thank you so much for your help!

Public Sub BestCompare()    Dim sFinalFileName As String
    sFinalFileName = InputBox("Name for merged file", _
      "This will be the output file")
    If sFinalFileName = "" Then End
    
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, strDocNm As String, sNName As String, sNFolder As String
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    Dim wdApp As New Word.Application, wdDoc As Word.Document
    With wdApp
        .Visible = False
        .ScreenUpdating = False
        With .Dialogs(wdDialogFileOpen)
            .Name = strFolder
            If .Show = -1 Then
                Set wdDoc = wdApp.ActiveDocument
            Else
                MsgBox "No source file selected. Exiting", vbExclamation
                Exit Sub
            End If
        End With
        sNFolder = wdDoc.Path
        strDocNm = wdDoc.FullName
        strFile = Dir(strFolder & "\*.doc", vbNormal)
        While strFile <> ""
            If strFolder & "\" & strFile <> strDocNm Then
                wdDoc.Merge FileName:=strFolder & "\" & strFile, _
                MergeTarget:=wdMergeTargetCurrent, DetectFormatChanges:=True, _
                UseFormattingFrom:=wdFormattingFromCurrent, AddToRecentFiles:=False
            End If
            strFile = Dir()
        Wend
        With wdDoc
            .SaveAs2 FileName:=sNFolder & "\" & sFinalFileName & ".docx"
        End With
        wdDoc.Close SaveChanges:=True
        .Quit
    End With
    Set wdDoc = Nothing: Set wdApp = Nothing
    Documents.Open FileName:=sNFolder & "\" & sFinalFileName & ".docx", ReadOnly:=False, AddToRecentFiles:=False, Visible:=True
    Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
    GetFolder = ""
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder of the merge files"
        If .Show = -1 Then
            GetFolder = .SelectedItems(1) & Chr(92)
        End If
    End With
End Function

[macropod]

Cross-posted at: https://www.mrexcel.com/forum/genera...illing-me.html
Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3

[h2whoa]

Cross-posted at: https://www.mrexcel.com/forum/genera...illing-me.html
Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3

Sorry all, I was unaware of the etiquette, which is my fault. Will make sure any future cross-posts are clearly labelled. Just wanted to give credit for the great help macropod provided.