Hi All,

I am trying to merge multiple visio files in to one. I am calling the visio object from Excel 2010. But I am getting "Invalid File Name" error in the below line of code

[VBA]Set CurrDoc = VsApp.Documents.OpenEx(CurrFileName, visOpenRO)[/VBA]

I tested this code in Visio 2010 & it was working perfectly. But now when I have migrated the code to Excel 2010. Its giving me the error. Below is the complete code snippet which I am using

[VBA]Sub Get_Files_For_Merge()
Start = Timer
Dim MyFile As String
Dim Counter As Long
Dim DirPath As String
Dim FilName As String
'Create a dynamic array variable, and then declare its initial size
Dim DirectoryListArray() As String
ReDim DirectoryListArray(1000)
FilName = Sheets("Launch Sheet").Range("C4").Value
'Loop through all the files in the directory by using Dir$ function
If Right(Sheets("Launch Sheet").Range("C6").Value, 1) = "\" Then
DirPath = Sheets("Launch Sheet").Range("C6").Value

Else

DirPath = Sheets("Launch Sheet").Range("C6").Value & "\"

End If
MyFile = Dir$(DirPath & "*.vsd")
Do While MyFile <> ""
DirectoryListArray(Counter) = MyFile
MyFile = Dir$
Counter = Counter + 1
Loop
'Reset the size of the array without losing its values by using Redim Preserve
ReDim Preserve DirectoryListArray(Counter - 1)
MergeDocuments DirectoryListArray

Finish = Timer
Total = Finish - Start
MsgBox "Done in " & Total & " secs"
End Sub
Sub MergeDocuments(FileNames() As String, Optional DestDoc As Visio.Document)
Dim VsApp As Visio.Application
Set VsApp = CreateObject("Visio.Application")
VsApp.Visible = True
'Set DestDoc = VsApp.Documents.Add("")

' merge into a new document if no document is provided
On Error GoTo PROC_ERR
If DestDoc Is Nothing Then
Set DestDoc = VsApp.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 = VsApp.Documents.OpenEx(CurrFileName, visOpenRO)
'VsApp.Documents.OpenEx(CurrFileNa
'
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

DestDoc.SaveAs Filename:="C:\Documents and Settings\sudhir_kb\My Documents\UU\Test2.vsd"

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
Application.ActiveWindow.SetViewRect 2.5, 8.885417, 11.520833, 6.041667
TheSelection.DeselectAll
End Sub
[/VBA]

I have added all Visio reference.
Please guide me as where I am going wrong.

Regards
Sudhir