Combining multiple Visio files - macro stopped working

[metagard1]

Hello!

Sometimes I have a need to combine several 200 page flowchart files together while preserving the original page names.

I have been using this macro (which I found on StackExchange) for some time, and it worked great until yesterday.

Now it throws run-time errors and I haven't had any luck so far with my attempts to fix it. I have experience with several other languages, but Visio-specific VBA is not my forte. I have tried it on files with which it previously worked, so it doesn't seem to be a problem with the files being combined. I'm not sure if a recent Windows Update changed the behavior of VBA or what.

Any help would be greatly appreciated!

I am using Visio Standard 2013 and VBA 7.1.1056 .

The errors read:
(This error is from this morning)
Run-time error '-2032465768 (86db0898)':
An exception occurred.

or

(This is the error from yesterday)
Run-time error '-2032465660 (86db0904)':
Object name not found.

Code is below:

Code Select Expand


Private Sub TryMergeDocs()
    Dim Docs() As Variant
    Docs = Array("file1.vsdx", "file2.vsdx", "file3.vsdx")
    MergeDocuments Docs
End Sub

Sub MergeDocuments(FileNames() As Variant, Optional DestDoc As Visio.Document)
    ' merge into a new document if no document is provided
    On Error GoTo PROC_ERR
    If DestDoc Is Nothing Then
        Set DestDoc = Application.Documents.Add("")
    End If

    Dim CheckPage As Visio.Page
    Dim PagesToDelete As New Collection
    For Each CheckPage In DestDoc.Pages
        PagesToDelete.Add CheckPage
    Next CheckPage
    Set CheckPage = Nothing

    ' loop through the FileNames array and open each one, and copy each page into destdoc
    Dim CurrFileName As String
    Dim CurrDoc As Visio.Document
    Dim CurrPage As Visio.Page, CurrDestPage As Visio.Page
    Dim CheckNum As Long
    Dim ArrIdx As Long
    For ArrIdx = LBound(FileNames) To UBound(FileNames)
        CurrFileName = CStr(FileNames(ArrIdx))
        Set CurrDoc = Application.Documents.OpenEx(CurrFileName, visOpenRO)
        For Each CurrPage In CurrDoc.Pages
            Set CurrDestPage = DestDoc.Pages.Add()
            With CurrDestPage
                On Error Resume Next
                Set CheckPage = DestDoc.Pages(CurrPage.Name)
                If Not CheckPage Is Nothing Then
                    While Not CheckPage Is Nothing ' handle duplicate names by putting (#) after the original name
                        CheckNum = CheckNum + 1
                        Set CheckPage = Nothing
                        Set CheckPage = DestDoc.Pages(CurrPage.Name & "(" & CStr(CheckNum) & ")")
                    Wend
                    CurrDestPage.Name = CurrPage.Name & "(" & CStr(CheckNum) & ")"
                Else
                    CurrDestPage.Name = CurrPage.Name
                End If
                On Error GoTo PROC_ERR
                Set CheckPage = Nothing
                CheckNum = 0

                ' copy the page contents over
                CopyPage CurrPage, CurrDestPage
                SetBackground CurrPage, CurrDestPage

            End With

            DoEvents
        Next CurrPage
        DoEvents
        Application.AlertResponse = 7

        CurrDoc.Close
    Next ArrIdx

    For Each CheckPage In PagesToDelete
        CheckPage.Delete 0
    Next CheckPage

PROC_END:
    Application.AlertResponse = 0
    Exit Sub

PROC_ERR:
    MsgBox Err.Number & vbCr & Err.Description
    GoTo PROC_END
End Sub

Sub CopyPage(CopyPage As Visio.Page, DestPage As Visio.Page)
    Dim TheSelection As Visio.Selection
    Dim CurrShp As Visio.Shape
    DoEvents
    Visio.Application.ActiveWindow.DeselectAll

    DestPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).Formula = CopyPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).ResultIU
    DestPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).Formula = CopyPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).ResultIU
    DestPage.Background = CopyPage.Background


    Set TheSelection = Visio.ActiveWindow.Selection

    For Each CurrShp In CopyPage.Shapes
        TheSelection.Select CurrShp, visSelect
        DoEvents
    Next

    TheSelection.Copy visCopyPasteNoTranslate
    DestPage.Paste visCopyPasteNoTranslate

    TheSelection.DeselectAll
End Sub

Sub SetBackground(CopyPage As Visio.Page, DestPage As Visio.Page)
   If Not CopyPage.BackPage Is Nothing Then
       DestPage.BackPage = CopyPage.BackPage.Name
   End If
End Sub


[metagard1]

Update:

I am going through and uninstalling all windows updates relating to MS Office and/or Visio from the last month in the hopes that one of them is causing the issue. No luck yet, though.

[Paul Herber]

When the code stops do you get any indication of which line caused the problem?

[Hey Ken]

Metagard1:

   Welcome to the forum!

   Not sure what's wrong with your code, but let me share my own macro for merging Visio files.  I've used it successfully on huge files (over 500 pages).  It has some degree of control over what to copy, such as starting and ending page numbers, specific text in the name of the page to be copied, plus a prompt asking to overwrite existing pages of the same name.  Pretty spiffy.

   One cool thing about the macro is that it has something that Visio does not provide: a dialog to browse for a file.  Took some doing to put it together, and now I use it all the time.

   Be careful if the file being merged has macros in it.  I've found that sometimes the two files' macros may interact in ways you don't expect.

   Good luck!

   - Ken

Code Select Expand



Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _
    pOpenfilename As OpenFileName) As Long

Private Declare Function GetActiveWindow Lib "user32" () As Long

Private Type OpenFileName
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
    End Type
Public Sub MergeVisioDocuments()

Dim TheSourcePages As Pages
Dim TheSourceFile  As String
Dim TheSourceDoc   As Document
Dim TheTargetDoc   As Document
Dim TheSourcePage  As Page
Dim TheTargetPage  As Page
Dim TheSelection   As Selection
Dim TheReply       As Integer
Dim SkipPageCopy   As Boolean
Dim TheShape       As Shape
Dim StartingPage   As Integer
Dim EndingPage     As Integer
Dim PageNumber     As Integer
Dim Astring        As String
Dim J              As Integer
Dim FoundText      As Boolean

Do While TheSourceFile = ""
    TheSourceFile = ThisDocument.BrowseForFile(TheTitle:="Enter full path and file name of file to merge into this one:")
    If TheSourceFile = "" Then Exit Sub
    If InStr(1, UCase(TheSourceFile), ".VSD") Then
    Else
        MsgBox "Select a Visio file, or click Cancel to exit"
        TheSourceFile = ""
        End If
    Loop

Do Until StartingPage < EndingPage
    Astring = "x"
    Do Until Astring = "" Or UCase(Astring) = "ALL" Or IsNumeric(Astring)
        Astring = InputBox("Enter starting page number (or blank to exit):", "Merge Visio Documents", "All")
        If Astring = "" Then Exit Sub
        If IsNumeric(Astring) Then
            StartingPage = CInt(Astring)
            End If
        If UCase(Astring) = "ALL" Then
            StartingPage = 1
            EndingPage = 3333
            End If
        Loop
    If UCase(Astring) = "ALL" Then
    Else
        Do Until Astring = "" Or IsNumeric(Astring)
            Astring = InputBox("Enter ending page number (or blank to exit):", "Merge Visio Documents", "Remainder")
            If Astring = "" Then Exit Sub
            If IsNumeric(Astring) Then
                EndingPage = CInt(Astring)
                End If
            If UCase(Astring) = "REMAINDER" Then
                EndingPage = 3333
                End If
            Loop
        If StartingPage > EndingPage Then
            MsgBox "Starting page number must be less than ending page number!"
            End If
        End If
    Loop

Astring = InputBox("Enter specific text on the pages to be copied, or blank for all pages:", "Merge Visio Documents")
           
Set TheTargetDoc = ActiveDocument
Set TheSourceDoc = Application.Documents.OpenEx(TheSourceFile, visOpenRO)

PageNumber = 0
Set TheSourcePages = TheSourceDoc.Pages
For PageNumber = 1 To TheSourcePages.Count
    Set TheSourcePage = TheSourcePages.Item(PageNumber)
    If PageNumber >= StartingPage And PageNumber <= EndingPage Then

        FoundText = False
        For J = 1 To TheSourcePage.Shapes.Count
            Set TheShape = TheSourcePage.Shapes(J)
            If InStr(UCase(TheShape.Text), UCase(Astring)) > 0 Then
                FoundText = True
                J = TheSourcePage.Shapes.Count
                End If
            Next J

        If FoundText Or Astring = "" Then
            SkipPageCopy = False
           
            If TheSourcePage.Background Then
                SkipPageCopy = True
            Else
                If ThisDocument.PageExists(TheSourcePage.Name, TheDocument:=TheTargetDoc) Then
                    TheReply = MsgBox("Page name """ & TheSourcePage.Name & """ already exists!  Replace page?", vbYesNo + vbDefaultButton2, "Kencil")
                    If TheReply = 6 Then
                        SkipPageCopy = False
                        TheTargetDoc.Pages(TheSourcePage.Name).Delete (0)
                    Else
                        SkipPageCopy = True
                        End If
                Else
                    SkipPageCopy = False
                    End If ' page exists
                End If ' not background
        Else
            SkipPageCopy = True
            End If
       
        If SkipPageCopy Then
        Else
            ActiveWindow.Page = TheSourcePage
            ActiveWindow.DeselectAll
            Set TheSelection = ActiveWindow.Selection
            For Each TheShape In TheSourcePage.Shapes
                TheSelection.Select TheShape, visSelect
                Next ' shape
            TheSelection.Copy visCopyPasteNoTranslate
            Application.EventsEnabled = False
            Set TheTargetPage = TheTargetDoc.Pages.Add
            Application.EventsEnabled = True
            TheTargetPage.Name = TheSourcePage.Name
            TheTargetPage.Paste visCopyPasteNoTranslate
            End If  ' If copying page
    Else
        ' skip this page
        End If
       
    Next ' Page

TheSourceDoc.Saved = True
TheSourceDoc.Close

End Sub

Function BrowseForFile(Optional TheTitle As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Opens dialog box to find or enter a file name.
' Returns full path plus file name
' Extract file name using GetFileNameFromPath(FullPathAndFile)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim FName As OpenFileName

FName.lStructSize = Len(FName)
FName.hwndOwner = GetActiveWindow()
FName.lpstrFilter = "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
FName.lpstrFile = Space$(254)
FName.nMaxFile = 255
FName.lpstrFileTitle = Space$(254)
FName.nMaxFileTitle = 255
FName.lpstrInitialDir = "C:\Users\" & UserName & "\Desktop" 'Set the initial directory to browse from
If TheTitle = "" Then
    FName.lpstrTitle = "Select Target File for Output"
Else
    FName.lpstrTitle = TheTitle
    End If
FName.flags = 0

If GetOpenFileName(FName) Then
     BrowseForFile = Trim(FName.lpstrFile)
Else
     BrowseForFile = ""
     End If
     
End Function

Public Function PageExists(ThePageName As String, Optional TheDocument As Document) As Boolean

Dim ThePage As Page
Dim TheDoc  As Document

PageExists = False
If TheDocument Is Nothing Then
    Set TheDoc = ActiveDocument
Else
    Set TheDoc = TheDocument
    End If
   
On Error GoTo NoPage
Set ThePage = TheDoc.Pages(ThePageName)
On Error GoTo 0
PageExists = True
Exit Function

NoPage:
On Error GoTo 0
PageExists = False

End Function



[metagard1]

Hey Ken:

Thanks so much for sharing your macro! Unfortunately, I tried it and got the same error as with my code (Object name not found). When I use the debug option from the error popup, it points at line 203:

Code Select Expand


Set ThePage = TheDoc.Pages(ThePageName)


When the code stops do you get any indication of which line caused the problem?

In my own code, the debug option points to line 34:

Code Select Expand


Set CheckPage = DestDoc.Pages(CurrPage.Name)


These lines are doing similar operations. I don't know what would cause VBA to suddenly not be able to assign pages to variables, but that seems to be the case here. 

It's worth mentioning that I have tried this on two different systems, the other running Visio 2010 with the same results.

[Paul Herber]

That line of code is checking to see if the page name in the source document already exists in the destination document. If it doesn't then I can certainly see that line of code causing an exception. You should add an exception handler around it. Ah, I've just noticed that the previous line is "On Error Resume Next" which I suppose is VBA's excuse for exception handling. In that case it should be doing the right thing i.e going to check if CheckPage is not empty.

[Hey Ken]

   Interesting...  That code should work fine, especially with the ON ERROR RESUME NEXT immediately before it.

   Let me ask: What's the page name?  I've found there are certain characters that can cause problems when used in a page name, including %, /, \, ?, and CHR(10).  Might be others, too.

   Let me also ask the obvious: Does that page actually exist?

   - Ken



P.S.  This is my 100th post to the forum!!

[metagard1]

Ken: Congrats on 100 posts! 

The page names in the file being copied over are all simple three digit numbers without any other weirdness.

Each file I'm combining has 200 pages like that, and the first file (copy destination) has several pages of front matter, i.e. title page, table of contents, etc. but none of those page names have odd characters, either.

This has me pretty stumped - I now have two known working macros which are now throwing the same error at essentially the same operation. I would like to think that if Microsoft had released some update that broke macros, they would also release a list of the affected functions and new guidelines for their use. I also would imagine a lot more people would be posting with similar issues.

I am still removing Windows Updates from my laptop, but I'm not very confident that they are the cause of this.

[wapperdude]

Since you know where the error occurs, you in the vba window, you add a pause code execution become the troublesome line.  Then, you can look at the values of the variables, e.g., CurrPage.Name, to see if it makes sense and is what you're expecting.

Wapperdude

[metagard1]

Hi wapperdude,

When I do this, the only portion of the problematic line which doesn't look to be correctly defined is:

DestDoc.Pages()

The part inside the parenthesis has the correct value. It seems like VBA is not liking the indexing using the .Pages property.

[wapperdude]

So, going thru your code, I see this line...

Code Select Expand

If DestDoc Is Nothing Then
        Set DestDoc = Application.Documents.Add("")
    End If

But, I fail to see where you actually give the DestDoc an actual as l file name.  I probably missed it.

Similarly, I see these lines...

Code Select Expand

For Each CurrPage In CurrDoc.Pages
            Set CurrDestPage = DestDoc.Pages.Add()
            With CurrDestPage

But I fail to see where CurrDestPage gets an actual value. 

Perhaps I'm missing something, or there's a coding issue?

Wapperdude

[Hey Ken]

Metagard1:

   It's possible you're hitting the same wall I did when I was working with very large Visio files.  When I hit 500 pages, it wouldn't save as a .vsdx anymore, so I fell back to saving in .vsd format.  I typically publish my huge drawing as a single large .pdf, but when I exceeded 566 pages, the .pdf creation process crashed Visio.  So I was forced to break it up into several smaller files.  Out of curiosity I used my merge macro to try to put it all back together again, but sometime near 300 merged pages, Visio crashed again.  What a mess!

   Since then, I've kept it all broke up as my only option, and haven't had a problem since.  I'd suggest you try using smaller pieces and see what happens.  That may prove to be your only option as well.


Wapperdude:

   My macro crashed as well, remember, on the same operation.  Surely you're not implying I have a bug in my code!  ;- )

   - Ken

[wapperdude]

@Ken:  LOL.  Well, my code experience is minimal...I would never  have ventured down this path...valley of shadow and death!

But, I look at those two lines and there needs to be something inside of the parentheses.  Otherwise what's being set is null.  So, in my limited understanding, I say, "Hmmmm...how does that work?  Hmmmm."

Wapperdude

[metagard1]

Metagard1:

   It's possible you're hitting the same wall I did when I was working with very large Visio files.  When I hit 500 pages, it wouldn't save as a .vsdx anymore, so I fell back to saving in .vsd format.  I typically publish my huge drawing as a single large .pdf, but when I exceeded 566 pages, the .pdf creation process crashed Visio.  So I was forced to break it up into several smaller files.  Out of curiosity I used my merge macro to try to put it all back together again, but sometime near 300 merged pages, Visio crashed again.  What a mess!

   Since then, I've kept it all broke up as my only option, and haven't had a problem since.  I'd suggest you try using smaller pieces and see what happens.  That may prove to be your only option as well.

Ken, it's funny you say that, because that is the whole reason I have these files in 200-page chunks. Not due to crashing, but just because of the general slowness with which Visio runs when the pages get up there. Historically I have been able to re-combine everything into a single file and PDF it (very slowly). However, I am getting this error on page 1, so unfortunately I think I have another issue here.

So, going thru your code, I see this line...

Code Select Expand

If DestDoc Is Nothing Then
        Set DestDoc = Application.Documents.Add("")
    End If

But, I fail to see where you actually give the DestDoc an actual as l file name.  I probably missed it.

Similarly, I see these lines...

Code Select Expand

For Each CurrPage In CurrDoc.Pages
            Set CurrDestPage = DestDoc.Pages.Add()
            With CurrDestPage

But I fail to see where CurrDestPage gets an actual value. 

Perhaps I'm missing something, or there's a coding issue?

Wapperdude

Wapperdude, those two lines ending in .Add() are creating new things.

In the first quote, if I don't supply a filename to house the final product, it creates a new file for that purpose. (Called DrawingXX.vsdx)

In the second quote, it creates a new page in the aforementioned new document for each page in the source document (CurrDoc).