I am struggling with the “'Read specified shape data fields from all shapes on all pages of all drawings in directory” portion of the code. I am not familiar with the syntax needed here, and also I’m not sure if I have to create objects and set objects to accomplish this.
One other part of the code that works, but not exactly how I would like is the “'Open first Visio file and read in file directory path and name information.” Really I just want to get the path for the directory in question, but I settled with this clumsy way because it is all I could get to work. Cleaning this part up would just be a bonus, low priority.
Sub GetData()
'This is program 1 of 2 that will generate a bill of material used for ordering
'Read certain shape data field information from every shape in Visio drawings.
'must read the data for every shape on every page of every drawing in the directory.
'The next program, 2 of 2, will then sort/condense this data to automatically fill in the
'spreadsheet programs are called from with the condensed information that will be used for ordering the material.
Dim Cnt1 As Integer 'Temporary Counting Variable
Dim Cnt2 As Integer 'Temporary Counting Variable
Dim FPath As String
Dim FPathName As String
Dim DataArray(100, 500, 500) As String 'Array to hold file names
Dim VisioApp As Object
Dim objFso As Object
Dim objFiles As Object
Dim objFile As Object
Dim WatchForError As Boolean
Dim PartNumber As String
Dim PartDescription As String
'Set Error Handling
On Error GoTo EarlyExit
WatchForError = True 'Set this to false near last line of code to skip error msgbox
'Clear array variables in array prior to entering data into them
Erase DataArray
'Open Visio application if not already open & set-up to allow opening each Visio drawing
If VisioApp Is Nothing Then
Set VisioApp = CreateObject("Visio.Application")
If VisioApp Is Nothing Then
MsgBox "Can't connect to Visio"
GoTo EarlyExit
End If
End If
Set VisioApp = GetObject(, "Visio.Application")
'Open first Visio file and read in file directory path and name information
FPathName = Application.GetOpenFilename(FileFilter:="Visio Files (*.VSD), *.VSD", Title:="Select First File In Directory")
If FPathName = "False" Then GoTo EarlyExit
VisioApp.documents.Open (FPathName)
FPath = VisioApp.ActiveDocument.Path
VisioApp.ActiveDocument.Close
'Create objects to get a count of files in the directory
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFiles = objFso.GetFolder(FPath).Files
'Read the file name of each Visio type file into the file name array. skip pdis.vsd and other file types
Cnt1 = 1
For Each objFile In objFiles
If UCase(Right(objFile.Path, (Len(objFile.Path) - InStrRev(objFile.Path, ".")))) = UCase("VSD") Then
If objFile.Name <> "pdis.vsd" Then
DataArray(Cnt1, 1, 1) = objFile.Name
End If
Cnt1 = Cnt1 + 1
End If
Next objFile
'Read specified shape data fields from all shapes on all pages of all drawings in directory.
For Cnt1 = 1 To 10 'Set to match 1st variable in array, this will run through each file
If DataArray(Cnt1, 1, 1) <> Empty Then
FPathName = FPath & DataArray(Cnt1, 1, 1)
VisioApp.documents.Open (FPathName)
Cnt2 = 1
For Each Page In VisioApp.Pages
For Each Shape In Shapes
DataArray(Cnt1, Cnt1 + 1, Cnt2) = PartNumber
DataArray(Cnt1, Cnt1 + 2, Cnt2) = PartDescription
Cnt2 = Cnt2 + 1
Next
Next
VisioApp.ActiveDocument.Close
End If
Next
VisioApp.Quit
WatchForError = False
EarlyExit:
'Clean up
If WatchForError = True Then
MsgBox "App failed"
Else
MsgBox "Successful"
End If
On Error Resume Next
Erase DataArray
Set objFile = Nothing
Set objFiles = Nothing
Set objFso = Nothing
Set VisioApp = Nothing
Set VisioDoc = Nothing
On Error GoTo 0
End Sub
One other part of the code that works, but not exactly how I would like is the “'Open first Visio file and read in file directory path and name information.” Really I just want to get the path for the directory in question, but I settled with this clumsy way because it is all I could get to work. Cleaning this part up would just be a bonus, low priority.
Sub GetData()
'This is program 1 of 2 that will generate a bill of material used for ordering
'Read certain shape data field information from every shape in Visio drawings.
'must read the data for every shape on every page of every drawing in the directory.
'The next program, 2 of 2, will then sort/condense this data to automatically fill in the
'spreadsheet programs are called from with the condensed information that will be used for ordering the material.
Dim Cnt1 As Integer 'Temporary Counting Variable
Dim Cnt2 As Integer 'Temporary Counting Variable
Dim FPath As String
Dim FPathName As String
Dim DataArray(100, 500, 500) As String 'Array to hold file names
Dim VisioApp As Object
Dim objFso As Object
Dim objFiles As Object
Dim objFile As Object
Dim WatchForError As Boolean
Dim PartNumber As String
Dim PartDescription As String
'Set Error Handling
On Error GoTo EarlyExit
WatchForError = True 'Set this to false near last line of code to skip error msgbox
'Clear array variables in array prior to entering data into them
Erase DataArray
'Open Visio application if not already open & set-up to allow opening each Visio drawing
If VisioApp Is Nothing Then
Set VisioApp = CreateObject("Visio.Application")
If VisioApp Is Nothing Then
MsgBox "Can't connect to Visio"
GoTo EarlyExit
End If
End If
Set VisioApp = GetObject(, "Visio.Application")
'Open first Visio file and read in file directory path and name information
FPathName = Application.GetOpenFilename(FileFilter:="Visio Files (*.VSD), *.VSD", Title:="Select First File In Directory")
If FPathName = "False" Then GoTo EarlyExit
VisioApp.documents.Open (FPathName)
FPath = VisioApp.ActiveDocument.Path
VisioApp.ActiveDocument.Close
'Create objects to get a count of files in the directory
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFiles = objFso.GetFolder(FPath).Files
'Read the file name of each Visio type file into the file name array. skip pdis.vsd and other file types
Cnt1 = 1
For Each objFile In objFiles
If UCase(Right(objFile.Path, (Len(objFile.Path) - InStrRev(objFile.Path, ".")))) = UCase("VSD") Then
If objFile.Name <> "pdis.vsd" Then
DataArray(Cnt1, 1, 1) = objFile.Name
End If
Cnt1 = Cnt1 + 1
End If
Next objFile
'Read specified shape data fields from all shapes on all pages of all drawings in directory.
For Cnt1 = 1 To 10 'Set to match 1st variable in array, this will run through each file
If DataArray(Cnt1, 1, 1) <> Empty Then
FPathName = FPath & DataArray(Cnt1, 1, 1)
VisioApp.documents.Open (FPathName)
Cnt2 = 1
For Each Page In VisioApp.Pages
For Each Shape In Shapes
DataArray(Cnt1, Cnt1 + 1, Cnt2) = PartNumber
DataArray(Cnt1, Cnt1 + 2, Cnt2) = PartDescription
Cnt2 = Cnt2 + 1
Next
Next
VisioApp.ActiveDocument.Close
End If
Next
VisioApp.Quit
WatchForError = False
EarlyExit:
'Clean up
If WatchForError = True Then
MsgBox "App failed"
Else
MsgBox "Successful"
End If
On Error Resume Next
Erase DataArray
Set objFile = Nothing
Set objFiles = Nothing
Set objFso = Nothing
Set VisioApp = Nothing
Set VisioDoc = Nothing
On Error GoTo 0
End Sub
