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





Reply With Quote