Word VBA problem that is killing me!

nucleotide_boy

New Member
Joined
Apr 23, 2008
Messages
10
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!

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
 
Last edited:

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Which document(s) do you not want to close without saving?
 
Upvote 0
Which document(s) do you not want to close without saving?

Hi Norie. Just by way of example, let's say the folder with documents with revisions in it is C:\FolderA. The files are saved in it as Doc1.docx, Doc2.docx, Doc3.docx and Doc4.docx. They are all based on OrigDoc.docx which is saved elsewhere, but have different revisions from different people. So the overall aim is to end up with one document that combines all the revisions.

As the code runs through, it will open each document and combine it with the previous one. So through the code iterations you end up with a file I'll call AllChanges.docx. So far so good.

The problem is, it will also leave all of the files that were saved in FolderA open.

Users may also have word files open from other projects that they might have forgotten to save.

So, I'm trying to get the code to save all of the documents that are still open after it has saved and closed the new AllChanges.docx files, except for any of the files from FolderA that are still open.

For the open FolderA files, I want it close them without saving the changes made during the running of the code.

I hope that makes sense!
 
Upvote 0
Why don't you close/save the documents as you go along?

i.e. open document, do stuff, close/save document, open next document, do stuff close/save document and so on.
 
Upvote 0
Why don't you close/save the documents as you go along?

i.e. open document, do stuff, close/save document, open next document, do stuff close/save document and so on.

That's not a bad idea, actually. I guess it would have to be in this part of the code:

Code:
    If sMergePath = vbNullString Then Exit Sub
    strFile = Dir$(sMergePath & "*.doc*")
    While strFile <> ""
        MergeDocument2 sMergePath & strFile
        i = i + 1
        strFile = Dir$()
    Wend

How would I go about modifying it? Thank you!
 
Upvote 0
Why don't you close/save the documents as you go along?

i.e. open document, do stuff, close/save document, open next document, do stuff close/save document and so on.

FYI, this got resolved, with some excellent help from Paul Edstein (macropod ) over at VBA Express.

In case this code is ever helpful to anyone else, here is the final thing:

Code:
Public Sub BestCompare()
    Dim sFinalFileName As String
    sFinalFileName = InputBox("Enter a name for the final output file", _
      "Merged filename")
    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
 
Upvote 0
Upvote 0

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top