Displaying a message box causes a difference in the execution of the following code. See '@ When I run the code with the message box, it properly displays the number of occurrences of the string "ID=", and only writes a line to a table when the condition of the test is met. When I take out the MsgBox, every URL, even those that have "0" occurrences of the "ID=0" are included in the table, and the variable intNoOfRef remains the same instead of having fresh data inserted into it.
Also, a quick question: When I insert this URL into a field in an access database of the type hyperlink, the text is inserted, but a hyperlink is not created. Any advice?
I'm also including the code for the two functions that were lifted verbatim from 'String Things v1.3
Copyright (c) 2003, 2004 Brian J. Payne
Also, a quick question: When I insert this URL into a field in an access database of the type hyperlink, the text is inserted, but a hyperlink is not created. Any advice?
Code:
Function Test(strPagesFirstSeenByGoogle As String)
On Error GoTo err_QueryGoogle1
'Variables from table to build keyword string
Dim strKeywordIn1 As String
Dim strKeywordIn2 As String
Dim strKeywordIn3 As String
Dim strRelevantToIn As String
Dim strReasonIn As String
Dim cn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strAmendments As String
Dim strBills As String
Dim strSQL As String
Dim intNoOfRef As Integer
Dim i As Integer
If IsNull(strPagesFirstSeenByGoogle) Then strPagesFirstSeenByGoogle = "d" 'Last 24 hours
'Other values, if we want m for month, y for year, m2, etc. 2 months, y2, etc = two years
'Open connection and recordset, using a predefined query
Set cn = CurrentProject.Connection
Set rst = cn.Execute("qryKeywords4Depts")
DoCmd.OpenForm "frmWebscrape", acNormal
Do While Not rst.EOF
'Initialize
strKeywordIn1 = ""
strKeywordIn2 = ""
strKeywordIn3 = ""
gstrInnerText = ""
DoCmd.SetWarnings False
'Loop through the query results to generate words to place into the SQL statement
If Not IsNull(rst("Keyword")) Then strKeywordIn1 = rst("Keyword")
If Not IsNull(rst("AddKeyword1")) Then strKeywordIn2 = rst("AddKeyword1")
If Not IsNull(rst("AddKeyword2")) Then strKeywordIn3 = rst("AddKeyword2")
'Create a variable string for bills that have passed
strBills = AllowApostrophes("[URL unfurl="true"]http://www.google.com/search?q="[/URL] & Chr$(34) & strKeywordIn1 & Chr$(34) & " + " & Chr$(34) & strKeywordIn2 & Chr$(34) & " site:[URL unfurl="true"]http://www.leg.state.nv.us/74th/Reports&num=100&hl=en&lr=&as_qdr="[/URL] & strPagesFirstSeenByGoogle & "filter=0")
i = i + 1
'@
GoToURL (strBills)
GetHTML
intNoOfRef = STCountIf(gstrInnerText, "ID=", False)
MsgBox "intNoOfRef for phrase ID = " & intNoOfRef & " in " & vbCrLf & gstrInnerText
If intNoOfRef >= 1 Then
'There is a match, and we need to put this URL and number of hits into a table for review
DoCmd.SetWarnings False
Debug.Print strBills & " - " & intNoOfRef
strSQL = "INSERT INTO WebHits (WebPageHit,NoOfRef) VALUES ('" & strBills & "'," & intNoOfRef & ");"
DoCmd.RunSQL strSQL
Else
'Do nothing.
End If
DoCmd.SetWarnings True
'@
'strSQL = "INSERT INTO WebHits (WebPageHit,NoOfRef) VALUES ('" & strBills & "'," & intNoOfRef & ");"
DoCmd.SetWarnings True
'Send the page to the supervisor for that section and/or other people.
'strAmendments = "[URL unfurl="true"]http://www.google.com/search?as_q=[/URL] " & rst!keyword & Chr$(34) = "en&num=100&btnG=Google+Search&as_epq=&as_oq=&as_eq=&lr=&cr=&as_ft=
i&as_filetype=&as_qdr=y&as_nlo=&as_nhi=&as_occt=any&as_dt=i&as_sitesearch=
http%3A%2F%2F[URL unfurl="true"]www.leg.state.nv.us%2F74th%2Fbills%2FAmendments%2F&as_rights=[/URL]
&safe=active"
'Debug.Print strAmendments
'Debug.Print strBills
'Application.FollowHyperlink strAmendments, newwindow:=True, addHistory:=False
'Application.FollowHyperlink strBills, newwindow:=True, addHistory:=False
rst.MoveNext
Loop
DoCmd.SetWarnings True
rst.Close
cn.Close
Exit Function
err_QueryGoogle1:
Select Case Err.Number
Case 3075 'There is a single quote embedded into the data being input.
strBills = AllowApostrophes(strBills)
Case 3129 'Invalid SQL Statement
MsgBox "Invalid SqlStatement: - " & strSQL
Resume Next
Case Else
ErrBox "Query google"
End Select
End FunctionI'm also including the code for the two functions that were lifted verbatim from 'String Things v1.3
Copyright (c) 2003, 2004 Brian J. Payne
Code:
Public Function STCountIf(sSource As String, _
sTarget As String, _
Optional bCaseSensitive As Boolean = ST_CASESENSITIVE) _
As Integer
'Searches the source string for all instances
' of the target string.
'Returns the count of target strings in the
' source string.
Dim iPos As Integer
Dim iLoop As Integer
Dim iHits As Integer
Dim iStrParm As Integer
iPos = 1
iStrParm = STCaseParm(bCaseSensitive)
iLoop = InStr(1, sSource, sTarget, iStrParm)
If iLoop <> 0 Then
iHits = iHits + 1
iPos = iLoop + 1
While iLoop <> 0
iLoop = InStr(iPos, sSource, sTarget, iStrParm)
If iLoop <> 0 Then
iPos = iLoop + 1
iHits = iHits + 1
End If
Wend
End If
STCountIf = iHits
End Function
Code:
Private Function STCaseParm(bCaseSensitive As Boolean) As Integer
'Private function to return the proper
' parameter value for calls to the VB library
If bCaseSensitive Then
STCaseParm = vbBinaryCompare
Else
STCaseParm = vbTextCompare
End If
End Function[
