-
Hi Antony,
Okay, I am in unfamiliar territory, so in a new/blank/throwaway workbook, try:
Rename Sheet1 "MyData".
Add a ActiveX command button to MyData.
In the Worksheet Module for MyData:
[vba]
Option Explicit
Private Sub CommandButton1_Click()
Call CoerceText_3("MyData")
End Sub
[/vba]
In a Standard Module:
[vba]
Option Explicit
Sub CoerceText_3(ShName As String)
Dim _
REX As Object, _
oMatches As Object, _
aryInput As Variant, _
aryOutput As Variant, _
i As Long
Set REX = CreateObject("VBScript.RegExp")
aryInput = Split(GrabSimplePage("http://www.peauction.com/pewiki.php"), "|", , vbTextCompare)
With REX
.Global = True
.MultiLine = False
.Pattern = "([\+]?[0-9]+\.[0-9]+%?)(.*_)(.*)"
'submatch 1: Maybe a plus sign, followed by (fb) one or more digits, _
fb decimal point, fb one or more digits, fb maybe a percent sign.
'submatch 2: Anything else until it hits an underscore (underscore is last char).
'submatch 3: Whatever is left.
ReDim aryOutput(LBound(aryInput) To UBound(aryInput), 1 To 2)
For i = LBound(aryInput) To UBound(aryInput)
If .Test(aryInput(i)) Then
Set oMatches = .Execute(aryInput(i))
aryOutput(i, 1) = oMatches(0).SubMatches(2)
aryOutput(i, 2) = oMatches(0).SubMatches(0)
Else
aryOutput(i, 1) = "No Match:"
aryOutput(i, 2) = aryInput(i)
End If
Next
With ThisWorkbook.Worksheets(ShName)
.Cells.ClearContents
With .Range("A2:B2")
.Font.Bold = True
.Value = Array("Item", "Markup")
End With
With .Range("A3").Resize(UBound(aryOutput, 1) - LBound(aryOutput, 1) + 1, 2)
.NumberFormat = "@"
.Value = aryOutput
.EntireColumn.AutoFit
End With
End With
End With
End Sub
'// Note Early-Bound
'// REQUIRED REFERENCE: Add a reference to "Microsoft HTML Object Library"
Function GrabSimplePage(ByVal strURL As String) As String
Dim _
htmDoc1 As HTMLDocument, _
htmDoc2 As HTMLDocument
'// This fails (429: cannot create object), but I don't know why?
'Set htmDoc1 = CreateObject("MSHTML.HTMLDocument")
'// As early-bound...
Set htmDoc1 = New HTMLDocument
Set htmDoc2 = htmDoc1.createDocumentFromUrl(strURL, "")
Do Until htmDoc2.readyState = "complete"
DoEvents
Loop
GrabSimplePage = htmDoc2.documentElement.outerText '.outerHTML
Set htmDoc1 = Nothing: Set htmDoc2 = Nothing
End Function
[/vba]
Seems to work fine even on my "poor ol' laptop" and not even too terribly slow. As you'll note, in this one we skipped the text file alltogether and use a function to grab the text instead.
As noted/commented in the code, this requires a reference to the "Microsoft HTML Object Library".
Hope that helps,
Mark
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules