On Error GoTo problem

[DeaPeaJay]

I'm trying to cycle through numerous Visio files in a folder, all with the same naming convention. "Complex99.vsd". So I have a counter that increments in a for loop and is concatenated to the filename string. But not all filenames are actually there. Some may jump from "Complex3.vsd" to "Complex6.vsd". So if I get an error, I want it to skip the whole loop and move on.

This works for the first run through ("Complex0.vsd") isn't there, so it skips the loop. Then it gets to "Complex1.vsd" and that file isn't there either, but this time it doesn't skip all the code. I can't figure out why.

Here's my code

Sub ComplexConsolidator()

    Dim vs As Object
    Set vs = CreateObject("Visio.Application")
    vs.Visible = True
    
    Dim strComplexPath As String
    strComplexPath = "\\ntdt02\eis\Roles\Telecom\LAN\Team_Information\Documentation\Complex\"
    
    Dim strFileName As String
    Dim strFullPath As String
    
    Dim strComplexPages(1000) As String
    Dim intCount As Integer
    Dim intToCount As Integer
    Dim intFileCount as Integer
    
    Dim strToName As String
    strToName = Application.ActiveDocument.Name
    
    
    
    
    
    Application.Windows.ItemEx(strToName).Activate

    For Each pg In ActiveDocument.Pages
        strComplexPages(intToCount) = pg.Name
        intToCount = intToCount + 1
    Next
    
'do trial and error, Complex1.vsd? complex2.vsd? All the way up to who
'knows what number.

[highlight]For intFileCount = 0 To 300
    strFileName = "Complex" & intFileCount & ".vsd"
    strFullPath = strComplexPath & strFileName
    
    On Error GoTo ErrorHandler
    vs.Documents.OpenEx strFullPath, visOpenRW + visOpenMacrosDisabled[/highlight]

    For Each pgComplex In vs.ActiveDocument.Pages 'For Each in current Complex
        For intCount = 0 To intToCount - 1 'For Each in Overview pages
            If strComplexPages(intCount) = pgComplex.Name Then
                vs.ActiveWindow.Page = vs.Application.ActiveDocument.Pages(pgComplex.Name)
                vs.Application.ActiveWindow.SelectAll
                vs.Application.ActiveWindow.Selection.Copy (visCopyPasteNoTranslate)
            
                Application.Windows.ItemEx(strToName).Activate
                Application.ActiveWindow.Page = Application.ActiveDocument.Pages(pgComplex.Name)
                
                Application.ActiveWindow.SelectAll
                Application.ActiveWindow.Delete
                Application.ActiveWindow.Page.Paste (visCopyPasteNoTranslate)
                Exit For
            End If
            If intCount = intToCount - 1 Then
                vs.ActiveWindow.Page = vs.Application.ActiveDocument.Pages(pgComplex.Name)
                vs.Application.ActiveWindow.SelectAll
                vs.Application.ActiveWindow.Selection.Copy (visCopyPasteNoTranslate)
            
                Dim UndoScopeID1 As Long
                UndoScopeID1 = Application.BeginUndoScope("Insert Page")
                Dim vsoPage1 As Visio.Page
                Set vsoPage1 = ActiveDocument.Pages.Add
                vsoPage1.Name = pgComplex.Name
                vsoPage1.Background = False
                vsoPage1.Index = intToCount
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).FormulaU = "18.8 in"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).FormulaU = "13.6 in"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageShdwOffsetX).FormulaU = "0.125 in"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageShdwOffsetY).FormulaU = "-0.125 in"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageScale).FormulaU = "1 in"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageDrawingScale).FormulaU = "1 in"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageDrawSizeType).FormulaU = "3"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowRulerGrid, visXRulerOrigin).FormulaU = "0.8 in"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowRulerGrid, visYRulerOrigin).FormulaU = "4.6 in"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowRulerGrid, visXGridOrigin).FormulaU = "0.8 in"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowRulerGrid, visYGridOrigin).FormulaU = "4.6 in"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLORouteStyle).FormulaU = "1"
                vsoPage1.PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPageOrientation).FormulaU = "2"
                Application.EndUndoScope UndoScopeID1, True
    
                Application.ActiveWindow.Page.Paste (visCopyPasteNoTranslate)
            End If
        Next
    Next
    vs.Documents.Close
[highlight]ErrorHandler:
Next
[/highlight]

End Sub

 

[PHV]

vs.Documents.Close
ResumeNext:
Next
Exit Sub

ErrorHandler:
Resume ResumeNext
End Sub

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[rmikesmith]

Try the following setup:

    On Error Resume Next
    vs.Documents.OpenEx strFullPath, visOpenRW + visOpenMacrosDisabled
   IF Err.Number = 0 Then
     For Each pgComplex In vs.ActiveDocument.Pages
     'Existing code
     Next pgComplex
   Else
     Err.Clear
   End If

Regards,
Mike

 

[HarleyQuinn]

How about avoiding the error in the first place?

Check if the file exists before trying to open/manipulate it:

For intFileCount = 0 To 300
    strFileName = "Complex" & intFileCount & ".vsd"
    strFullPath = strComplexPath & strFileName
    
    'On Error GoTo ErrorHandler
If Dir(strFullPath) <> vbNullString Then
    vs.Documents.OpenEx strFullPath, visOpenRW + visOpenMacrosDisabled
'Do the rest...
else
'Do nothing
End if
Next

Hope this helps

HarleyQuinn
---------------------------------
Help us to help you,
read FAQ222-2244 before posting.

 

[HarleyQuinn]

Wow, I was slow there...

HarleyQuinn
---------------------------------
Help us to help you,
read FAQ222-2244 before posting.

 

[DeaPeaJay]

Hey, thank you all. I'm learning here, AND you fixed my problem Thanks

 

[Zathras]

This works in Excel: I don't know if it can work in Visio.

Option Explicit

Sub ProcessAllFiles()
Dim i As Integer
With Application.FileSearch
    .LookIn = "c:\Archive"
    .FileType = msoFileTypeAllFiles
    .FileName = "Complex"
    .Execute
    If .FoundFiles.Count > 0 Then
      For i = 1 To .FoundFiles.Count
        ProcessOneFile .FoundFiles.Item(i)
      Next i
    Else
      MsgBox "No files were found."
    End If
End With
End Sub

Sub ProcessOneFile(AFileName As String)
  MsgBox AFileName
End Sub

 

[DeaPeaJay]

Zathras,
That would have been super if that script worked. That's what I've been wanting to do. But it threw up the unsupported property or method error on me

 

[PHV]

You may simply play with the Dir function:
strComplexPath = "\\ntdt02\eis\Roles\Telecom\LAN\Team_Information\Documentation\Complex\"
strFileName = Dir(strComplexPath & "Complex*.vsd")
While strFileName <> ""
strFullPath = strComplexPath & strFileName
' your code here
strFileName = Dir()
WEnd

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Zathras]

Sorry to hear that. It works fine for me in Excel 97.

You never did actually specify what application you are running this macro in.

If you are using Excel, perhaps there is a Reference missing. (Tools/References...)

 

[DeaPeaJay]

oh, yah its in Visio

 

[DeaPeaJay]

PHV,
THANK YOU. That works like a charm. You all have been lots of help!

 

[Zathras]

If you have Excel on your system, perhaps you can "borrow" it:

Option Explicit

Sub ProcessAllFiles()
Dim e As New Excel.Application
Dim i As Integer
With e.Application.FileSearch
    .NewSearch
    .LookIn = "\\ntdt02eis\Roles\Telecom\LAN\Team_Information\Documentation\Complex\"
    .FileType = msoFileTypeAllFiles
    .FileName = "Complex"
    .Execute
    If .FoundFiles.Count > 0 Then
      For i = 1 To .FoundFiles.Count
        ProcessOneFile .FoundFiles.Item(i)
      Next i
    Else
      MsgBox "No files were found."
    End If
End With
End Sub

Sub ProcessOneFile(AFileName As String)
  MsgBox AFileName
End Sub

 

[PHV]

Zathras, seems you like the sledge hammer way ... ;-)

 

[Zathras]

Well, maybe so. But if the FileSearch object is available, it provides a few advantages. Not the least of which is the ability to give a progress report in the status bar in the form of "Processing n of nn files"

 

[PHV]

I wonder if we can replace this (ie not instantiate excel):
Dim e As New Excel.Application
With e.Application.FileSearch
with this:
Dim fs As New Office.FileSearch
With fs

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[rmikesmith]

Just remember... Today's sledgehammer is tomorrow's must-have tool .

Zathras, thanks for the tip.


Regards,
Mike

 

[Zathras]

PHV, that looks good, but I couldn't get it to run that way. Am I missing a reference?

I get "Invalid use of New keyword" and "Office" is not in the pop-up list when I type "Dim fs As New "

Excel 97 SR-2

 

[PHV]

Am I missing a reference?
Microsoft Office x.y Object Library

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Zathras]

Hmmmmmm, I have "Microsoft Ofice 8.0 Object Library" ticked. Perhaps it requires a newer version than '97

I can try again tonight when I get home. I have 2000 to play with there.