View Full Version : Button to interrupt subroutine
DanOfEarth
07-05-2010, 10:49 AM
On the crawler I built, it takes up to thirty minutes to check the whole database via a do-with loop.
Is there a way to have an input box or equivilent that will hang there "stop" it in midstream if pressed? I've been trying DoWhile and DoUntil methods without any luck.
mdmackillop
07-05-2010, 01:05 PM
There may be better ways to do this using arrays. Can you post your code and possibly a sample workbook?
DanOfEarth
07-06-2010, 01:52 PM
Here's the routine:
Sub QueryMLS()
Const MyUrl As String = "http://search.har.com/engine/doSearch.cfm?QUICKSEARCH="
Sheets("Import").Visible = True
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
With Sheets("Leads")
Set Address = ActiveCell
Set Street = ActiveCell.Offset(0, 1)
End With
With Sheets("Import").QueryTables.Add(Connection:= _
"URL;" & MyUrl & Address & " " & Street _
, Destination:=Sheets("Import").Range("Import!$A$1"))
.Name = "doSearch.cfm?QUICKSEARCH=802%20Hallmark%20Oak"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
If Range("Results") = "Search Result: (0) Records Found. " Then
ActiveCell.Offset(0, 5).Formula = "Z - N/A"
ActiveCell.Offset(0, 6).Formula = "Z - N/A"
ElseIf Range("Results") = "Search Result: (1) Records Found. " Then
ActiveCell.Offset(0, 5).Formula = Range("AgentName")
ActiveCell.Offset(0, 6).Formula = Range("AgentFirm")
Else
ActiveCell.Offset(0, 5).Formula = "Z - Townhouse"
ActiveCell.Offset(0, 6).Formula = "Z - Townhouse"
ActiveCell.Offset(0, 7).Formula = "Z - Townhouse"
End If
ActiveCell.Offset(0, 8).Formula = Date
ActiveCell.Offset(1, 0).Select
Loop
Sheets("Import").Visible = False
End Sub
It data-mines or "scrapes" a web page's search function and pastes results into my workbook.
mdmackillop
07-06-2010, 02:39 PM
A simple Start/Stop routine. Assign a button to each.
Sub DoStart()
Dim i
Do Until Range("A1").Value = "Stop"
i = i + 1
Cells(1, 2) = i
DoEvents
Loop
Cells(1, 1).ClearContents
End Sub
Sub DoStop()
Cells(1, 1) = "Stop"
End Sub
DanOfEarth
07-06-2010, 03:32 PM
Well,
I gave that a shot. What happens is that while the subroutine is working, the hour-glass pointer stays on....not able to hit the "Stop" button while running.
Hmmmm.
mdmackillop
07-07-2010, 12:34 AM
Sorry, without some data, I can't test using your code.
DanOfEarth
07-07-2010, 02:59 AM
Thanks mac. That's O.K. I put it on the back burner for now, because I've got another bigger issue on that same subroutine that I'm posting that I hope I can fix. Ironically it's basically shut down the very subroutine I was trying "shut down" with that very button, so to speak. :)
But if I can get it to work, I'll have a somewhet sophisticated web-crawler. I'm shocked at some of the stuff I've been able to program recently.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.