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/general-excel-discussion-other-questions/1021909-word-vba-problem-killing-me.html
Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3

[h2whoa]

Cross-posted at: https://www.mrexcel.com/forum/general-excel-discussion-other-questions/1021909-word-vba-problem-killing-me.html
Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#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.