Hello once again. I am trying to make a VBA Project to automate a process at my office within Microstation. Please see the below image:
Upon the click event the button in the bottom right will scan through the Listview Row by Row and scans the active design file for a text element matching the respective value for "Movement ID". I have done a good bit of debugging and I am running into a bizarre error. I am getting a type mismatch error on the ElementEnumerator.Current.AsTextElement.Text. The value is being returned as "Pattern Control Element".
Does anyone have any idea what would cause this error?
Modeless Dialog Class
Public filePath As String Private Sub bBrowse_Click()' Select File Dialog On Error GoTo addLibrary_Error Dim strFilter As String' Filter files by File Extension *.csv strFilter = ahtAddFilterItem(strFilter, "Exported Traffic Data (*.csv)", "*.csv")' Prompt for File filePath = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=False, _ DialogTitle:="Select a *.csv with Traffic Counts to Import:", _ initialDir:=MAIN.initialDir, _ Flags:=ahtOFN_READONLY)' Verify Entry If IsNull(filePath) Or filePath = "" Then GoTo addLibrary_Error End If' Set the file path MAIN.initialDir = Left(filePath, InStrRev(filePath, "\")) tFileName.Text = filePath' Populate the listview populateListView Exit Sub addLibrary_Error: MsgBox ("Please Select a valid *.csv File. Contact Jon Nicholson with questions.") End Sub' Populate the rows of the list view Public Sub populateListView()' Clear existing Items CountListView.ListItems.Clear' Open File into Stream Dim strTextLine As String Dim headerHit As Integer: headerHit = 0 Dim fso As FileSystemObject: Set fso = New FileSystemObject Set txtStream = fso.OpenTextFile(filePath, ForReading, False) Do While Not txtStream.AtEndOfStream strTextLine = txtStream.ReadLine With CountListView If headerHit = 1 Then ' Add the counts Line by Line Dim lArr() As String lArr = Split(strTextLine, ",") Dim li As ListItem Set li = .ListItems.Add(Text:=lArr(0)) li.ListSubItems.Add , , lArr(1) li.ListSubItems.Add , , lArr(2) li.ListSubItems.Add , , lArr(3) Else ' Skip the CSV Header headerHit = 1 End If End With Loop txtStream.Close End Sub ' Replace in CAD Private Sub bImplementCAD_Click() Dim i As Integer For i = 1 To CountListView.ListItems.Count Dim findText As String: findText = CountListView.ListItems.Item(i) Dim AM As String: AM = CountListView.ListItems.Item(i).SubItems(1) Dim PM As String: PM = CountListView.ListItems.Item(i).SubItems(2) Dim DAILY As String: DAILY = CountListView.ListItems.Item(i).SubItems(3) Dim ReplaceText As String: ReplaceText = AM & vbNewLine & "(" & PM & ")" Call Process.findReplaceText(findText, ReplaceText) Next End Sub ' Initialize the List Box Private Sub UserForm_Initialize() With CountListView .view = lvwReport .Checkboxes = False .FullRowSelect = True .GridLines = True With .ColumnHeaders .Clear .Add , , "Movement ID", 60 .Add , , "AM Count", 60 .Add , , "PM Count", 60 .Add , , "Daily", 60 End With End With End Sub
Text Replacement Class
Option Explicit' Searches in text strings and nested cells
Private sToFind As String ' Find text
Private sToReplace As String ' Replace with this text
Sub findReplaceText(strIn As String, strOut As String)
Dim Ee As ElementEnumerator
Dim Sc As New ElementScanCriteria
sToFind = strIn
sToReplace = strOut
Sc.ExcludeAllTypes
Sc.IncludeType msdElementTypeText
Sc.IncludeType msdElementTypeTextNode
Set Ee = ActiveModelReference.Scan(Sc)
' Browse current model and start the test routine:
Do While Ee.MoveNext
Call complexSearch(Ee.Current)
Loop
End Sub' Subroutine for recursively browsing nested complex elements
Sub complexSearch(oEle As Element)
Dim EeSub As ElementEnumerator' If a complex element or text node is found, check all sub-elements:
If (oEle.IsComplexElement) Or (oEle.Type = msdElementTypeTextNode) Then
Set EeSub = oEle.AsComplexElement.GetSubElements
Do While EeSub.MoveNext
Call complexSearch(EeSub.Current)
Loop' Otherwise string compare, if a text is present:
Else
If oEle.Type = msdElementTypeText Then
If InStr(oEle.AsTextElement.Text, sToFind, vbTextCompare) > 0 Then
MsgBox (oEle.AsTextElement.Text)
oEle.AsTextElement.Text = sToReplace
oEle.Rewrite
End If
End If
End If
End Sub
I would greatly appreciate any help getting this resolved!!
~Matt