VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "Anchors" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" Attribute VB_Ext_KEY = "Collection" ,"Anchor" Attribute VB_Ext_KEY = "Member0" ,"Anchor" Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 'local variable to hold collection Private mCol As Collection Public Function Add(Optional sKey As String) As Anchor 'create a new object Dim objNewMember As Anchor Set objNewMember = New Anchor 'set the properties passed into the method objNewMember.Index = mCol.Count + 1 If Len(sKey) = 0 Then mCol.Add objNewMember Else mCol.Add objNewMember, sKey End If 'return the object created Set Add = objNewMember Set objNewMember = Nothing End Function Public Property Get Item(vntIndexKey As Variant) As Anchor Attribute Item.VB_UserMemId = 0 'used when referencing an element in the collection 'vntIndexKey contains either the Index or Key to the collection, 'this is why it is declared as a Variant 'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5) Set Item = mCol(vntIndexKey) End Property Public Property Get Count() As Long 'used when retrieving the number of elements in the 'collection. Syntax: Debug.Print x.Count Count = mCol.Count End Property Public Sub Remove(vntIndexKey As Variant) 'used when removing an element from the collection 'vntIndexKey contains either the Index or Key, which is why 'it is declared as a Variant 'Syntax: x.Remove(xyz) Dim i As Integer mCol.Remove vntIndexKey For Each xobj In mCol i = i + 1 xobj.Index = i Next End Sub Public Property Get NewEnum() As IUnknown Attribute NewEnum.VB_UserMemId = -4 Attribute NewEnum.VB_MemberFlags = "40" 'this property allows you to enumerate 'this collection with the For...Each syntax Set NewEnum = mCol.[_NewEnum] End Property Private Sub Class_Initialize() 'creates the collection when this class is created Set mCol = New Collection End Sub Private Sub Class_Terminate() 'destroys collection when this class is terminated Set mCol = Nothing End Sub Public Sub CompileList(strData As String) Dim anchorOpenBegin As Long Dim anchorOpenEnd As Long Dim anchorCloseBegin As Long Dim anchorCloseEnd As Long Dim anchorbody As String Dim Splitter As Variant Dim splitter1 As Variant Dim xCol As Collection Dim xa As Anchor anchorOpenBegin = InStr(1, strData, " 0 Set xa = New Anchor xa.Index = mCol.Count + 1 anchorOpenEnd = InStr(anchorOpenBegin, strData, ">") anchorbody = Mid(strData, anchorOpenBegin, anchorOpenEnd - anchorOpenBegin) Splitter = Split(anchorbody, " ") For i = 0 To UBound(Splitter) If InStr(1, Splitter(i), "=") Then splitter1 = Split(Splitter(i), "=", 2) If splitter1(0) = "href" Then xa.link = Replace(splitter1(1), Chr(34), "") xa.NamePositionStart = InStr(anchorOpenBegin, strData, "href") + 6 ' 6 - href=" xa.NamePositionEnd = xa.NamePositionStart + Len(xa.link) End If End If Next anchorCloseBegin = InStr(anchorOpenEnd, strData, "", strData) xa.TitlePositionStart = anchorOpenEnd + 1 xa.TitlePositionEnd = anchorCloseBegin anchorbody = Mid(strData, xa.TitlePositionStart, xa.TitlePositionEnd - xa.TitlePositionStart) xa.Title = anchorbody mCol.Add xa DoEvents anchorOpenBegin = InStr(anchorOpenBegin + 1, strData, " 0 Set xa = New Anchor anchorOpenEnd = InStr(anchorOpenBegin, strData, ">") If anchorOpenEnd = 0 Then GoTo zzz anchorbody = Mid(strData, anchorOpenBegin, anchorOpenEnd - anchorOpenBegin) Splitter = Split(anchorbody, " ") For i = 0 To UBound(Splitter) If InStr(1, Splitter(i), "=") Then splitter1 = Split(Splitter(i), "=", 2) If LCase(splitter1(0)) = "href" Then xa.link = Replace(splitter1(1), Chr(34), "") End If End If Next anchorCloseBegin = InStr(anchorOpenEnd, LCase(strData), "") End If mvarTitlePositionStart = anchorOpenEnd + 1 mvarTitlePositionEnd = anchorCloseBegin anchorbody = Mid(strData, mvarTitlePositionStart, mvarTitlePositionEnd - mvarTitlePositionStart) xa.Title = anchorbody zz: anchorOpenBegin = InStr(anchorOpenBegin + 1, LCase(strData), "-->