Variant Array from Concatenated String

[sckuperman]

Greetings,

I found several threads on MrExcel and several other sites that listed code to accomplish both halves of what I am trying to do; but I am having a hard time marrying them.

First, I want to be able to use VBA to open an "Excel.Application.FileDialog(msoFileDialogFilePicker)" in ***VISIO*** (using the reference to the Excel Library, which I have specified), to select multiple Visio files...

Next, I want to be able to merge those documents into one Visio file with multiple sheets.

I started out by finding and adjusting the code to create a series of subroutines for the last half of this project - and when I hard code the file names into an array of type variant, since I don't yet have a way to fill a variable, I just typed each file name encapsulated in quotes and separated them by commas, I can run the main sub and successfully merge the files into one. Half success!

Then I found and adjusted different code in a new sub to open a file dialog in Visio, even though Visio doesn't natively allow this like Excel or Word does. I can select the files I want (the same ones I hard coded in the other half of this project, for example), and create a clean string that looks identical to what I hard-coded, with quotes and all. I don't know how to put the files names into the variant array expected by the other sub. I believe (perhaps incorrectly) that the other sub wants a variant array because it is using LBound and UBound functions to cycle through the list of file names. I have searched all throughout this and other forums including Microsoft and general Google to find the answer. I tried using CVAR on the string but I still get a type mismatch error. I tried using Split to populate the array, but that also creates an error at run time. I tried outputting the string to a MsgBox, just to visualize what might be going on with the string, I tried formatting the string in different ways in case there were extra characters or quotes included in the array...

So then I either need help to convert the string to the variant array needed by the other sub(s); OR, I need help to adjust the other subs to use the data in the string.

I'm truly stuck! Even if you don't use Visio, this code requires the Excel library to operate, and I'm hoping someone might be able to review this code and see an obvious error I can fix.

My code is as follows.

Sub MergeFiles()
Dim Docs() As Variant
Dim Doks As String
Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String
Dim i As Integer
Set fd = Excel.Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "Select Site Diagrams To Merge"
fd.InitialFileName = "c:\"
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True
FileChosen = fd.show
If FileChosen = -1 Then
For i = 1 To fd.SelectedItems.Count
Doks = Doks & Chr(34) & fd.SelectedItems(i) & Chr(34) & ","          '<------- THIS CREATES A STRING SUCH AS: "E:\MY DOCS\FILE1.VDX", "E:\MY DOCS\FILE2.VDX"
Next i                                                                                    '            When typed this way in a variant array such as Docs("e:\my docs\file1.vdx","e:\my docs\file1.vdx"
End If                                                                                    '             without the need for the dialog box code, running MergeDocuments Docs works perfectly.
Doks = Left(Doks, Len(Doks) - 1)

                 'Docs = Split(Doks, ",")                                            '<------  HERE IS WHERE I TRIED TO SPLIT; I ALSO TRIED CVAR...

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


            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


    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

YOUR HELP IS EXTREMELY APPRECIATED!

 

[Andrew Poulsom]

Split should work but you need to remove the parentheses here:

Dim Docs() As Variant
Sub MergeDocuments(FileNames() As Variant, Optional DestDoc As Visio.Document)

 

[sckuperman]

Split should work but you need to remove the parentheses here:

Dim Docs() As Variant
Sub MergeDocuments(FileNames() As Variant, Optional DestDoc As Visio.Document)

Hi, Andrew:

I tried that, but I get a "File not found" error at run time. This leads me to believe that, although Split is probably working (debugging doesn't break at the Split and allows the routine to complete), whatever is going into Docs from Doks; or whatever is parsing to the FileNames array isn't following the format expected by the MergeDocuments sub, which is converting the array back into a string!

Would you be able to please help me identify the most concise code to rewrite the MergeDocuments sub so that it can perhaps parse the Doks string itself, which according to a debugging MsgBox appears to be in the correct format, if I were to run it all manually by hardcoding an array with the file names as variant? I'm not only very confused at this point as to the actual flow of data, but to the construct as a whole.

For example, right now, I believe that:

For ArrIdx = LBound(FileNames) To UBound(FileNames)
        CurrFileName = CStr(FileNames(ArrIdx))
        Set CurrDoc = Application.Documents.OpenEx(CurrFileName, visOpenRO)

is the culprit. Am I wrong?

Again, thank you for any and all help. This is driving me insane.

 

[sckuperman]

SUCCESS!

Writing that last reply helped me to think through the issue... Yes, I changed what the MergeDocument sub was parsing to a string that then Split into a variant array, *at that stage*.

I ALSO played a hunch in the way Windows was reporting the results from the File Open Dialog Box and removed the CHR(34) "quotes" which were possibly (and evidently are) redundant.

Here is the total code that now works perfectly. It might not be the cleanest implementation, but it works well. Now, I'll add a dialog to request a 'new file name' for DestDoc and have a finished project. Thanks for helping me troubleshoot!

Sub MergeFiles()
Dim Docs As Variant
Dim Doks As String
Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String
Dim i As Integer
Set fd = Excel.Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "Select Site Diagrams To Merge"
fd.InitialFileName = "c:\"
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True
FileChosen = fd.show
If FileChosen = -1 Then
For i = 1 To fd.SelectedItems.Count
Doks = Doks & fd.SelectedItems(i) & ","
Next i
End If
Doks = Left(Doks, Len(Doks) - 1)
Docs = Split(Doks, ",")
MergeDocuments Doks
'   MsgBox Doks
End Sub


Sub MergeDocuments(FileNames As String, 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 Dokks As Variant
      Dim ii As Integer
      Dokks = Split(FileNames, ",")
      For ii = 0 To UBound(Dokks)
      CurrFileName = CStr(Dokks(ii))
           
        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


            End With
            DoEvents
        Next CurrPage
        DoEvents
        Application.AlertResponse = 7


        CurrDoc.Close
Next ii


    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


    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