NFL Gambling News, Pro and College Links , Advice, Picks.

Option Compare Database

Private Sub Command217_Click()
End Sub
Private Sub Command24_Click()
On Error GoTo Err_Command24_Click

DoCmd.GoToRecord , , acLast
Exit_Command24_Click:
Exit Sub
Err_Command24_Click:
MsgBox Err.Description
Resume Exit_Command24_Click

End Sub
Private Sub Command25_Click()
On Error GoTo Err_Command25_Click
DoCmd.GoToRecord , , acNewRec
Exit_Command25_Click:
Exit Sub
Err_Command25_Click:
MsgBox Err.Description
Resume Exit_Command25_Click
End Sub
Private Sub Command26_Click()
On Error GoTo Err_Command26_Click
Me.data_mmyydd = Now()
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Exit_Command26_Click:
Exit Sub
Err_Command26_Click:
MsgBox Err.Description
Resume Exit_Command26_Click
End Sub
Private Sub Command27_Click()
On Error GoTo Err_Command27_Click
Dim oApp As Object
Set oApp = CreateObject("Word.Application")
oApp.Visible = True
Exit_Command27_Click:
Exit Sub
Err_Command27_Click:
MsgBox Err.Description
Resume Exit_Command27_Click

End Sub
Private Sub Command28_Click()
On Error GoTo Err_Command28_Click

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 2, , acMenuVer70
Exit_Command28_Click:
Exit Sub
Err_Command28_Click:
MsgBox Err.Description
Resume Exit_Command28_Click

End Sub
Private Sub Command30_Click()
On Error GoTo Err_Command30_Click

Call Shell("NOTEPAD.EXE", 1)
Exit_Command30_Click:
Exit Sub
Err_Command30_Click:
MsgBox Err.Description
Resume Exit_Command30_Click

End Sub
Private Sub CommandButton1_Click()
TextBox2.SelStart = 0
TextBox2.SelLength = TextBox2.TextLength
TextBox2.Cut
TextBox1.SetFocus
TextBox1.SelStart = 0

TextBox1.Paste
TextBox2.SelStart = 0
End Sub

Private Sub Command32_Click()
On Error GoTo Err_Command32_Click

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 2, , acMenuVer70
Exit_Command32_Click:
Exit Sub
Err_Command32_Click:
MsgBox Err.Description
Resume Exit_Command32_Click

End Sub
Private Sub Command43_Click()
On Error GoTo Err_Command43_Click
Dim oApp As Object
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
'Only XL 97 supports UserControl Property
On Error Resume Next
oApp.UserControl = True
Exit_Command43_Click:
Exit Sub
Err_Command43_Click:
MsgBox Err.Description
Resume Exit_Command43_Click

End Sub
Private Sub Command48_Click()
On Error GoTo Err_Command48_Click

Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Command48_Click:
Exit Sub
Err_Command48_Click:
MsgBox Err.Description
Resume Exit_Command48_Click

End Sub
Private Sub Command49_Click()
On Error GoTo Err_Command49_Click

DoCmd.GoToRecord , , acFirst
Exit_Command49_Click:
Exit Sub
Err_Command49_Click:
MsgBox Err.Description
Resume Exit_Command49_Click

End Sub
Private Sub Command50_Click()
On Error GoTo Err_Command50_Click

DoCmd.GoToRecord , , acNext
Exit_Command50_Click:
Exit Sub
Err_Command50_Click:
MsgBox Err.Description
Resume Exit_Command50_Click

End Sub
Private Sub Command51_Click()
On Error GoTo Err_Command51_Click

DoCmd.GoToRecord , , acPrevious
Exit_Command51_Click:
Exit Sub
Err_Command51_Click:
MsgBox Err.Description
Resume Exit_Command51_Click

End Sub
Private Sub data_descr_Click()
On Error GoTo Errorhandler
Dim sstrng, schar, stpos, endpos, sposa, spose
Dim sanf As Long, send As Long, mleng As Long
Dim desta, desend, contsta
' _________
contsta = "content="""
desta = "description"""
desend = """>"
' _________
sposa = 1
stpos = 1
sanf = 0
send = 0
' _________
sstrng = Me![data_HTML]
stpos = InStr(sposa, sstrng, desta, 1)
stpos = InStr(stpos, sstrng, contsta, 1)
endpos = InStr(stpos, sstrng, desend, 1)
' __________
sanf = stpos
sanf = sanf + Len(contsta)
send = endpos
' MsgBox send - sanf
mleng = send - sanf
If (mleng >= 255) Then
mleng = 255
' MsgBox ("Description length changed to: ") & mleng
Else
' MsgBox ("unchanged")
End If

Me![data_descr] = Mid(Me![data_HTML], sanf, mleng)
Exit Sub
Errorhandler:
Me![data_descr] = "Description: no data stored"
' MsgBox ("stpos: ") & stpos & ("endpos: ") & endpos & ("desta: ") & desta & ("deend: ") & desend
Exit Sub
End Sub


Private Sub data_keyw_Click()
On Error GoTo Errorhandler
Dim sstrng, schar, stpos, endpos, sposa, spose
Dim sanf As Long, send As Long, mleng As Long
Dim kwsta, kwend, contsta, contend
' _________
kwsta = "keywords"""
contsta = "content="""
kwend = """>"
desta = "description"
desend = """>"
' _________
sposa = 1
stpos = 1
sanf = 0
send = 0
' _________
sstrng = Me![data_HTML]
stpos = InStr(sposa, sstrng, kwsta, 1)
stpos = InStr(stpos, sstrng, contsta, 1)
' sstrng = Me![data_HTML]
endpos = InStr(stpos, sstrng, kwend, 1)
'
' MsgBox kwsta & contsta
' MsgBox stpos & " " & endpos
' __________
sanf = stpos
sanf = sanf + Len(contsta)
send = endpos
mleng = send - sanf
If (mleng >= 255) Then
mleng = 255
' MsgBox ("Description length changed to: ") & mleng
Else
' MsgBox ("unchanged")
End If

Me![data_keyw] = Mid(Me![data_HTML], sanf, mleng)
Exit Sub
Errorhandler:
Me![data_keyw] = "Keyw:no data stored"
' MsgBox ("stpos: ") & stpos & ("endpos: ") & endpos & ("keysta: ") & keysta & ("keyend: ") & keyend
Exit Sub
End Sub
Private Sub data_len_Click()
Me![data_len] = Len([data_HTML])
End Sub

Private Sub data_loopresult_Click()
End Sub
Private Sub data_title_Click()
On Error GoTo Errorhandler
Dim sstrng, schar, stpos, endpos, sposa, spose
Dim sanf As Long, send As Long
Dim tista, tiend
' _________
tista = ""
' _________
sposa = 1
stpos = 1
sanf = 0
send = 0
' _________
sstrng = Me![data_HTML]
stpos = InStr(sposa, sstrng, tista, 1)
stpos = stpos + Len(tista)
sstrng = Me![data_HTML]
endpos = InStr(stpos, sstrng, tiend, 1)
' __________
sanf = stpos
send = endpos
' MsgBox sanf & endpos & Len(tista)
Me![data_title] = Mid(Me![data_HTML], sanf, send - sanf)
Exit Sub
Errorhandler:
Me![data_title] = "Title:no data stored"
' MsgBox ("stpos: ") & stpos & ("endpos: ") & endpos & ("tista: ") & tista & ("tiend: ") & tiend
Exit Sub
End Sub
Private Sub List237_Click()
ww_Click
End Sub
Private Sub T63_Click()
' check the end of HTML
On Error GoTo Errorhandler
Dim sstrng, schar, stpos, endpos, sposa, spose
Dim sanf As Long, send As Long
Dim bodsta, htmsta
' _________
sposa = 1
stpos = 1
sanf = 0
send = 0
' _________
bodsta = ""
htmsta = ""
sstrng = Me![data_HTML]
stpos = InStr(sposa, sstrng, bodsta, 1)
Me![T63] = Mid(Me![data_HTML], stpos, send - sanf)
stpos = stpos + Len(bodsta)
endpos = InStr(stpos, sstrng, htmsta, 1)
' Me![data_what] = Me![data_what] & " found" ' bodsta or htmsta
Exit Sub
Errorhandler:
Me![data_what] = Me![data_what] & " no found"
' MsgBox ("stpos: ") & stpos & ("endpos: ") & endpos & ("tista: ") & tista & ("tiend: ") & tiend
Exit Sub
End Sub
Private Sub T65_Click()
' check PayPal
On Error GoTo Errorhandler
Dim sstrng, schar, stpos, endpos, sposa, spose
Dim sanf As Long, send As Long
Dim bodsta, htmsta
' _________
sposa = 1
stpos = 1
sanf = 0
send = 0
' _________
Me![T65] = " "
bodsta = "PayPal"
sstrng = Me![data_HTML]
stpos = InStr(sposa, sstrng, bodsta, 1)
If stpos = 0 Then GoTo Errorhandler ' nop
' MsgBox ("stpos: ") & stpos & ("send:") & send & ("sanf:") & sanf
send = stpos + Len(bodsta)
sanf = stpos
Me![T65] = Mid(Me![data_HTML], stpos, send - sanf) ' PayPal

Me![data_what] = Me![data_what] & "\" & bodsta & " inside" & stpos & "\" ' PayPal & inside & stpos
Exit Sub
Errorhandler:
' Me![T65] = " error paypal search" ' blank or set it to this text
' MsgBox ("stpos: ") & stpos & ("endpos: ") & endpos & ("tista: ") & tista & ("tiend: ") & tiend
Exit Sub
End Sub
Private Sub checkTKD_what_Click()
On Error GoTo Err_checkTKD_what_Click
Dim stDocName As String
' stDocName = "Macro2"
' DoCmd.RunMacro stDocName
' MsgBox "now the fields with the subs "
Me!data_what = " "
data_title_Click
data_keyw_Click
data_descr_Click
data_len_Click
T63_Click
T65_Click

' MsgBox "done"
Exit_checkTKD_what_Click:
Exit Sub
Err_checkTKD_what_Click:
' MsgBox Err.Description
Resume Exit_checkTKD_what_Click

End Sub
Private Sub anfang_Click()
On Error GoTo Err_anfang_Click
Dim i, j, k
DoCmd.GoToRecord , , acFirst ' set start of file
k = DMax("[data_runnum]", "data_stor_sites")
MsgBox k
' hier
On Error GoTo Err_ende_Click
looping:
'
data_len_Click
T63_Click ' body
T65_Click 'paypal
'
If Me![data_runnum] = k Then GoTo looping_end
DoCmd.GoToRecord , , acNext ' read next rec in a loop till end
GoTo looping
looping_end:
MsgBox "ende loop"
DoCmd.GoToRecord , , acFirst ' set start of file
Exit Sub
' _________________________________
Exit_anfang_Click:
Exit Sub
'
Err_anfang_Click:
MsgBox "error anfang"
MsgBox Err.Description
Resume Exit_anfang_Click
Exit Sub
Err_ende_Click:
MsgBox "error ende"
MsgBox Err.Description
Exit Sub
End Sub
Private Sub Command183_Click()
On Error GoTo Err_Command183_Click

DoCmd.GoToRecord , , acNewRec
Exit_Command183_Click:
Exit Sub
Err_Command183_Click:
MsgBox Err.Description
Resume Exit_Command183_Click

End Sub
Private Sub Command184_Click()
On Error GoTo Err_Command184_Click
Dim stDocName As String
stDocName = "Macro2.check_dataSpiderText"
DoCmd.RunMacro stDocName
Exit_Command184_Click:
Exit Sub
Err_Command184_Click:
MsgBox Err.Description
Resume Exit_Command184_Click

End Sub
Private Sub Command199_Click()
On Error GoTo Err_Command199_Click

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 2, , acMenuVer70
Exit_Command199_Click:
Exit Sub
Err_Command199_Click:
MsgBox Err.Description
Resume Exit_Command199_Click

End Sub
Private Sub Command210_Click()
On Error GoTo Err_Command210_Click
Dim stDocName As String
' MsgBox "210click"
stDocName = "Macro2.check_working"
DoCmd.RunMacro stDocName ' Paste
' MsgBox "pasted"
Command211_Click ' set fields Text, Keyw, Html + upd
' MsgBox "done"
'
Command50_Click ' Next Record
Exit_Command210_Click:
Exit Sub
Err_Command210_Click:
MsgBox Err.Description
Resume Exit_Command210_Click

End Sub
Private Sub Command211_Click()
' Finger
On Error GoTo Errorhandler
Dim sstrng, schar, stpos, endpos, sposa, spose
Dim sanf As Long, send As Long
Dim stDocName As String
Dim tista, tiend As String
'
tista = "TEXT:"
tiend = "Distinct Words: "
sposa = 1
stpos = 1
sanf = 0
send = 0
sstrng = Me![data_store]
' MsgBox ("len:" & Len([data_store]))
stpos = InStr(sposa, sstrng, tista, 1)
stpos = stpos + Len(tista)
sstrng = Me![data_store]
endpos = InStr(stpos, sstrng, tiend, 1)
sanf = stpos + 2
send = endpos + Len(tiend) + 5
Me![data_spidertext] = Mid(Me![data_store], sanf, send - sanf)
' ____________________________________________
tista = "Keyword Count Density"
tiend = "13 "
sposa = 1
stpos = 1
sanf = 0
send = 0
sstrng = Me![data_store]
stpos = InStr(sposa, sstrng, tista, 1)
stpos = stpos + Len(tista)
sstrng = Me![data_store]
endpos = InStr(stpos, sstrng, tiend, 1)
sanf = stpos + 3
send = endpos + Len(tiend)
Me![data_swho_rank] = Mid(Me![data_store], sanf, send - sanf)
' ____________________________________________
tista = "HTML:"
tiend = "\\\end "
sposa = 1
stpos = 1
sanf = 0
send = 0
sstrng = Me![data_store]
stpos = InStr(sposa, sstrng, tista, 1)
stpos = stpos + Len(tista)
sstrng = Me![data_store] & tiend
endpos = InStr(stpos, sstrng, tiend, 1)
sanf = stpos + 2
send = endpos + Len(tiend)
Me![data_HTML] = Mid(Me![data_store], sanf, send - sanf)
Me![data_store] = "ok" ' no longer needed;
Command26_Click ' Set date + Update
Command50_Click ' Next Rec
Exit Sub
Errorhandler:
MsgBox (" *** check length data-store : " & sanf & "\" & send & "\" & (send - sanf))
If (send <= 1) Then MsgBox "end<= 1. Click again or try single pasting Text,Keyword density and HTML from input"
Me!data_store = " " ' no longer needed; not stored
Exit Sub
Me![data_store] = " *** no data stored *** "
MsgBox ("stpos: ") & stpos & ("endpos: ") & endpos & ("tista: ") & tista & ("tiend: ") & tiend
Exit Sub

End Sub
Private Sub ww_Click()
On Error GoTo Errorhandler
Dim sstrng, schar, stpos, sposa, spose, rec_end, inc, inchr
Dim sanf As Long, send As Long, totallength As Long, endpos As Long
Dim i, j, k
Dim tista, tiend
'
k = DMax("[data_runnum]", "data_stor_sites") ' max loop recs
MsgBox k
'
rec_end = "\\\end>>>"
tiend = ">"
If Me![List237] = "GoTo LOOP_RECORD
End If
If Me![List237] = "tista = "GoTo LOOP_RECORD
End If
If Me![List237] = "tista = "GoTo LOOP_RECORD
End If
If Me![List237] = "tista = "GoTo LOOP_RECORD
End If
If Me![List237] = "tista = "GoTo LOOP_RECORD
End If
If Me![List237] = "tista = "GoTo LOOP_RECORD
End If
inc = InputBox("What to search: startvalue =", "1.searchvalue like[ tista = inc
inc = InputBox("What to search: endvalue =", "1.searchvalue like[>]")
tiend = inc
'
LOOP_RECORD:
i = 1
sposa = 1
stpos = 1
sanf = 0
send = 0
endpos = 1
' _________
sstrng = Me![data_HTML] & rec_end ' take html
totallength = Len(sstrng)
' MsgBox "totallength:" & totallength
inchr = Chr(13)
Me![data_loopresult] = "Search Values for " & Me![data_url] & inchr & " \0[" & tista & "] to [" & tiend & "]:"
' MsgBox "val:" & stpos & "\" & endpos & "\" & i
LOOP_NEXT_val:
stpos = InStr(sposa, sstrng, tista, 1)
If stpos = 0 Then GoTo UPDATE_LOOPRESULT
' sstrng = Me![data_HTML] & rec_end ' take html
endpos = InStr(stpos, sstrng, tiend, 1)
'
sanf = stpos ' act. start
send = endpos ' act. end
send = send + Len(tiend) - 1 ' + 2.searchvalue
'
Me![data_loopresult] = Me![data_loopresult] & inchr & "\1." & i & ":" & Mid(Me![data_HTML], sanf, send - sanf + 1)
'
[Forms]![workform]![t0] = [Forms]![workform]![t0] & Me![site_Name] & inchr
' MsgBox "workform ok"
' prepare next value
sposa = send + 1
stpos = 0
endpos = 0
Me![data_loopres_count] = i ' set count
i = i + 1
GoTo LOOP_NEXT_val
Exit Sub
'
UPDATE_LOOPRESULT:
' MsgBox "update"
Command26_Click ' upd with date
Command50_Click ' get next
If Me![data_runnum] = k Then GoTo looping_end
' MsgBox "next rec"
GoTo LOOP_RECORD
Exit Sub
looping_end:
MsgBox "ende loop, back to top"
DoCmd.GoToRecord , , acFirst ' set start of file
Exit Sub

' _____________________________________________
Errorhandler:
' MsgBox "end record" & stpos
MsgBox "++++errorend+++++: stpos" & stpos & "\" & endpos & "\" ' end rec
If stpos = 0 Then GoTo UPDATE_LOOPRESULT
Me![data_loopresult] = "Values:no data stored"
MsgBox Err.Description
Exit Sub

End Sub