Save all open documents except intermediate documents in document combine macro
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.
Code:
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
