Skip to content
Browse files

Initial commit

  • Loading branch information...
0 parents commit ceec46cfe444b822aa20376d6f7ef0c4d3203af8 @brymck brymck committed Sep 5, 2011
71 Class Modules/ConnectionTemplate.cls
@@ -0,0 +1,71 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "ConnectionTemplate"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Private pName As String
+Private pSelectors As New Collection
+Private pURL As String
+Private pUseAbbreviations As Boolean
+
+Public Function CreateConnection(ByVal Query As String, _
+ ByVal Frequency As Long, _
+ ByRef Abbreviations() As Variant) As ImportConnection
+ Dim Connection As New ImportConnection
+ Dim Index As Long
+ Dim ParamLength As Long
+
+ ParamLength = UBound(Abbreviations)
+
+ With Connection
+ For Index = 0 To ParamLength
+ Dim Abbreviation As Variant
+ Abbreviation = Abbreviations(Index)
+ .Add pSelectors.Item(Abbreviation)
+ Next
+
+ .Frequency = Frequency
+ .URL = sprintf(pURL, Query)
+ End With
+
+ Set CreateConnection = Connection
+End Function
+
+Public Sub SelectorsFromRange(ByRef Selectors As Variant, _
+ ByRef Abbreviations As Variant)
+ Dim Index As Long
+ Dim SelectorsLength As Long
+
+ SelectorsLength = UBound(Selectors)
+ Set pSelectors = New Collection
+
+ ' If we're using abbreviations, the params should have the short name
+ ' followed by the selector text
+ For Index = 1 To SelectorsLength
+ pSelectors.Add Selectors(Index, 1), Abbreviations(Index, 1)
+ Next
+End Sub
+
+Public Property Get Abbreviations() As String()
+ Abbreviations = pAbbrevs
+End Property
+
+Public Property Get Name() As String
+ Name = pName
+End Property
+Public Property Let Name(ByVal Value As String)
+ pName = Value
+End Property
+Public Property Get UseAbbreviations() As Boolean
+ UseAbbreviations = pUseAbbreviations
+End Property
+Public Property Get URL() As String
+ URL = pURL
+End Property
+Public Property Let URL(ByVal Value As String)
+ pURL = Value
+End Property
124 Class Modules/ImportConnection.cls
@@ -0,0 +1,124 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "ImportConnection"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Private Const SECONDS_PER_DAY As Double = 86400
+
+Private pURL As String
+Private pIE As SHDocVw.InternetExplorer
+Private pSelectors As New Collection
+Private pFreq As Long
+Private pValues As Variant
+Private pNext As Date
+
+Private Sub Class_Initialize()
+ ForceUpdate
+End Sub
+
+Public Sub UpdateAll(ByVal Selectors As Variant)
+ Dim Index As Long
+ Dim SelectorLength As Long
+
+ SelectorLength = UBound(Selectors)
+ Set pSelectors = New Collection
+
+ For Index = 0 To SelectorLength
+ pSelectors.Add Selectors(Index)
+ Next
+
+ ForceUpdate
+End Sub
+
+Public Sub Refresh()
+ pIE.Refresh
+ ForceUpdate
+End Sub
+
+Private Sub CreateExplorerInstance(ByVal URL As String)
+ Dim ShellWindows As New SHDocVw.ShellWindows
+ Dim Instance As SHDocVw.InternetExplorer
+
+ On Error Resume Next
+ For Each Instance In ShellWindows
+ If Instance.Document.URL = URL Then
+ Set pIE = Instance
+ Exit Sub
+ End If
+ Next
+
+ ' Create a new one if nothing else exists
+ Set pIE = New SHDocVw.InternetExplorer
+ pIE.Navigate URL
+End Sub
+
+Public Property Get URL() As String
+ URL = pURL
+End Property
+Public Property Let URL(ByVal Value As String)
+ pURL = Value
+ CreateExplorerInstance URL
+End Property
+
+Public Property Get IE() As SHDocVw.InternetExplorer
+ Set IE = pIE
+End Property
+
+Public Property Get Document() As MSHTML.HTMLDocument
+ Set Document = pIE.Document
+End Property
+
+' Generic collection methods
+Public Sub Add(ByVal Selector As String)
+ pSelectors.Add Selector
+ ForceUpdate
+End Sub
+Public Property Get Count() As Long
+ Count = pSelectors.Count
+End Property
+Public Function Item(ByVal Index As Long) As String
+ Set Item = pSelectors.Item(Index)
+End Function
+Public Sub Remove(ByVal Index As Long)
+ pSelectors.Remove Index
+End Sub
+
+Public Property Get Values() As Variant
+ Dim Index As Long
+ Dim SelectorLength As Long
+
+ SelectorLength = pSelectors.Count
+ ReDim pValues(1 To SelectorLength)
+
+ For Index = 1 To SelectorLength
+ Dim Value As Variant
+ Value = Document.querySelector(pSelectors(Index)).innerText
+ If IsNum(Value) Then
+ pValues(Index) = CDbl(Value)
+ Else
+ pValues(Index) = Value
+ End If
+ Next
+
+ Values = pValues
+ pNext = Now() + pFreq / SECONDS_PER_DAY
+End Property
+
+Public Property Get Frequency() As Long
+ Frequency = pFreq
+End Property
+Public Property Let Frequency(ByVal Value As Long)
+ pFreq = Value
+End Property
+
+Public Property Get NextUpdate() As Date
+ NextUpdate = pNext
+End Property
+
+Private Sub ForceUpdate()
+ pNext = Now()
+End Sub
49 Class Modules/ImportManager.cls
@@ -0,0 +1,49 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "ImportManager"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private pConnections As New Collection
+
+' Generic collection methods
+Public Sub Add(ByRef Connection As ImportConnection)
+ pConnections.Add Connection
+End Sub
+Public Property Get Count() As Long
+ Count = pConnections.Count
+End Property
+Public Function Item(ByVal Index As Long) As ImportConnection
+ Item = pConnections.Item(Index)
+End Function
+Public Sub Remove(ByVal Index As Long)
+ pConnections.Remove Index
+End Sub
+
+Public Function Find(ByVal URL As String) As ImportConnection
+ Dim Connection As ImportConnection
+
+ ' Find a connection with a matching URL, returning nothing if no match is found
+ On Error Resume Next
+ For Each Connection In pConnections
+ If Connection.URL = URL Then
+ Find = Connection
+ Exit Function
+ End If
+ Next
+End Function
+
+Public Sub CleanUp()
+ Dim ShellWindows As New SHDocVw.ShellWindows
+ Dim Instance As SHDocVw.InternetExplorer
+ Debug.Print ShellWindows.Count
+
+ For Each Instance In ShellWindows
+ Instance.Quit
+ Next
+End Sub
52 Class Modules/TemplateManager.cls
@@ -0,0 +1,52 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "TemplateManagEr"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Private pTemplates As New Collection
+
+' Generic collection methods
+Public Function Add(ByVal Name As String, _
+ ByVal URL As String, _
+ ByRef Selectors As Variant, _
+ ByRef Abbreviations As Variant) As ConnectionTemplate
+ Dim Template As ConnectionTemplate
+ Set Template = Find(Name)
+
+ If Template Is Nothing Then
+ Set Template = New ConnectionTemplate
+
+ pTemplates.Add Template, Name
+ End If
+
+ With Template
+ .Name = Name
+ .SelectorsFromRange Selectors, Abbreviations
+ .URL = URL
+ End With
+
+ Set Add = Template
+End Function
+Public Property Get Count() As Long
+ Count = pTemplates.Count
+End Property
+Public Function Item(ByVal Index As Long) As ConnectionTemplate
+ Item = pTemplates.Item(Index)
+End Function
+Public Sub Remove(ByVal Index As Long)
+ pTemplates.Remove Index
+End Sub
+
+Public Function Find(ByVal Name As String) As ConnectionTemplate
+ Dim Template As ConnectionTemplate
+
+ On Error Resume Next
+ Set Template = pTemplates.Item(Name)
+ On Error GoTo 0
+
+ Set Find = Template
+End Function
9 Microsoft Excel Objects/Sheet1.cls
@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "Sheet1"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
9 Microsoft Excel Objects/ThisWorkbook.cls
@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "ThisWorkbook"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
30 Modules/Explorer.bas
@@ -0,0 +1,30 @@
+Attribute VB_Name = "Explorer"
+Option Explicit
+
+Private Manager As New ImportManager
+
+Public Function ImportHTML(ByVal URL As String, _
+ ByVal UpdateFrequency As Long, _
+ ParamArray Selectors() As Variant) As Variant
+ Dim Connection As ImportConnection
+ Set Connection = Manager.Find(URL)
+
+ If Connection Is Nothing Then
+ Set Connection = New ImportConnection
+ Connection.URL = URL
+ Manager.Add Connection
+ Else
+ Connection.Refresh
+ End If
+
+ With Connection
+ .Frequency = UpdateFrequency
+ .UpdateAll Selectors
+ End With
+
+ ImportHTML = Connection.Values
+End Function
+
+Public Sub CleanUp()
+ Manager.CleanUp
+End Sub
15 Modules/LibCaller.bas
@@ -0,0 +1,15 @@
+Attribute VB_Name = "LibCaller"
+Option Explicit
+
+Public Function SizeToCaller(ByRef Arr As Variant)
+ ' Dimension array to size of calling rows and columns
+ With Application.Caller
+ If .Rows.Count > .Columns.Count Then
+ CallerMax = .Rows.Count
+ ReDim Arr(1 To CallerMax, 1 To 1)
+ Else
+ CallerMax = .Columns.Count
+ ReDim Arr(1 To 1, 1 To CallerMax)
+ End If
+ End With
+End Function
30 Modules/LibIsNum.bas
@@ -0,0 +1,30 @@
+Attribute VB_Name = "LibIsNum"
+Option Explicit
+
+Public Function IsNum(ByVal Value As String, _
+ Optional ByVal RespectLocale As Boolean = False) As Boolean
+ Dim DecimalPoint As String
+ Dim ThousandsSeparator As String
+
+ If RespectLocale Then
+ DecimalPoint = Format$(0, ".")
+ ThousandsSeparator = Mid$(Format$(1000, "#,###"), 2, 1)
+ Else
+ DecimalPoint = "."
+ ThousandsSeparator = ","
+ End If
+
+ ThousandsSeparator = Mid$(Format$(1000, "#,###"), 2, 1)
+ Value = Replace$(Value, ThousandsSeparator, "")
+
+ If Value Like "[+-]*" Then
+ Value = Mid$(Value, 2)
+ End If
+
+ IsNum = Not Value Like "*[!0-9" & DecimalPoint & "]*" And _
+ Not Value Like "*" & DecimalPoint & "*" & DecimalPoint & "*" And _
+ Len(Value) > 0 And _
+ Value <> DecimalPoint
+End Function
+
+
34 Modules/LibPerf.bas
@@ -0,0 +1,34 @@
+Attribute VB_Name = "LibPerf"
+Option Explicit
+
+Private ScreenUpdateState As Boolean
+Private StatusBarState As Boolean
+Private CalcState As XlCalculation
+Private EventsState As Boolean
+Private PageBreaksState As Boolean
+
+Public Sub OptimizePerformance()
+ With Application
+ ScreenUpdatingState = .ScreenUpdating
+ StatusBarState = .DisplayStatusBar
+ CalcState = .Calculation
+ EventsState = .EnableEvents
+ PageBreaksState = ActiveSheet.DisplayPageBreaks
+
+ .ScreenUpdating = False
+ .DisplayStatusBar = False
+ .Calculation = xlCalculationManual
+ .EnableEvents = EventsState
+ ActiveSheet.DisplayPageBreaks = PageBreaksState
+ End With
+End Sub
+
+Public Sub RestoreFunctionality()
+ With Application
+ .ScreenUpdating = ScreenUpdateState
+ .DisplayStatusBar = StatusBarState
+ .Calculation = CalcState
+ .EnableEvents = EventsState
+ ActiveSheet.DisplayPageBreaks = PageBreaksState
+ End With
+End Sub
15 Modules/LibSprintf.bas
@@ -0,0 +1,15 @@
+Attribute VB_Name = "LibSprintf"
+Option Explicit
+
+Private Const REPLACE_COUNT As Integer = 1
+
+' Mimics sprintf for %s
+Public Function sprintf(ByVal Str As String, ParamArray Args()) As String
+ Dim Arg As Variant
+
+ For Each Arg In Args
+ Str = Replace(Str, "%s", Arg, , REPLACE_COUNT)
+ Next Arg
+
+ sprintf = Str
+End Function
28 Modules/Templates.bas
@@ -0,0 +1,28 @@
+Attribute VB_Name = "Templates"
+Option Explicit
+
+Private Manager As New TemplateManager
+
+Public Function CustomTemplate(ByVal Name As String, _
+ ByVal URL As String, _
+ ByRef Selectors As Range, _
+ ByRef Abbreviations As Range) As String
+ CustomTemplate = Manager.Add(Name, URL, Selectors.Value, Abbreviations.Value).Name
+End Function
+
+Public Function ImportTemplate(ByVal Name As String, _
+ ByVal Query As String, _
+ ByVal Frequency As Long, _
+ ParamArray Abbreviations() As Variant) As Variant
+ Dim Parsed() As Variant
+ Dim Index As Long
+ Dim Length As Long
+ Length = UBound(Abbreviations)
+
+ ReDim Parsed(0 To Length)
+ For Index = 0 To Length
+ Parsed(Index) = Abbreviations(Index)
+ Next
+
+ ImportTemplate = Manager.Find(Name).CreateConnection(Query, Frequency, Parsed).Values
+End Function
4 README.md
@@ -0,0 +1,4 @@
+fas
+===
+
+Still pretty early.
BIN fas.xls
Binary file not shown.

0 comments on commit ceec46c

Please sign in to comment.
Something went wrong with that request. Please try again.