"Lauren Wilson" <no****@nospam. com> wrote in message
news:94******** *************** *********@4ax.c om...
Thanks for your response. Here's more info that might help:
We have about 4200 users spread out all over North America and some in
Central & South America. However, each of those users access THEIR
data on local MDBs. The ONLY need for this Client to Web server
interface is to do things like check for new versions AND to control
licensing. So, the program will be internally making ALL the calls to
the server and the user will not know it's happening. Concurrent
users hitting the web DB for license validation and/or update info
should be VERY rare but it WILL happen. Each user's machine will only
check these things about twice per month.
Having just been woken up by my 16 month old daughter at 4:15, and finding
myself unable to get back to sleep I decided to write a demo. This form
simply requires a textbox 'txtQuestion' and a command button 'cmdAnswer'.
You type in a question, press the button and it magically gets the answer
across the internet. The questions can be of the format:
What is the capital of Greece?
What is the population of Poland?
When you create the form you will need to set a reference to "Microsoft
Internet Controls"
Please do try this out, as I took the bother to write it for you, but please
also note that the database it queries is not mine, nor do I know the
authors. This means that they may change the format at any time and also
may get fed up if millions of Access databases across the world start
hitting it with requests.
' *** Code Starts ***
Option Compare Database
Option Explicit
Private Enum QuestionTypeEnu m
UnknownQuestion
CapitalQuestion
PopulationQuest ion
End Enum
Dim WithEvents ixp As InternetExplore r
Dim m_lngSeconds As Long
Dim m_lngTimeout As Long
Dim m_QuestionType As QuestionTypeEnu m
'
Private Sub cmdAnswer_Click ()
On Error GoTo Err_Handler
Dim strQuestion As String
Dim strURL As String
strQuestion = Trim(Nz(Me.txtQ uestion, ""))
If strQuestion Like "What is the capital of *" Then
strURL = Mid$(strQuestio n, 24)
If Right$(strURL, 1) = "?" Then
strURL = Left$(strURL, Len(strURL) - 1)
End If
strURL = "www.worldessen tials.com/capital.asp" & _
"?country=" & strURL
m_QuestionType = QuestionTypeEnu m.CapitalQuesti on
ElseIf strQuestion Like "What is the population of *" Then
strURL = Mid$(strQuestio n, 27)
If Right$(strURL, 1) = "?" Then
strURL = Left$(strURL, Len(strURL) - 1)
End If
strURL = "www.worldessen tials.com/population.asp" & _
"?country=" & strURL
m_QuestionType = QuestionTypeEnu m.PopulationQue stion
Else
strQuestion = "Enter a question such as:" & vbCrLf & _
"What is the capital of France? or" & vbCrLf & _
"What is the population of Italy?"
MsgBox strQuestion, vbInformation
Me.txtQuestion. SetFocus
Exit Sub
End If
DoCmd.Hourglass True
ixp.Navigate2 strURL
m_lngTimeout = 10
m_lngSeconds = 0
Me.TimerInterva l = 1000
Exit_Handler:
Exit Sub
Err_Handler:
DoCmd.Hourglass False
MsgBox Err.Description , vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Sub
Private Sub Form_Open(Cance l As Integer)
On Error GoTo Err_Handler
Cancel = True
Set ixp = New InternetExplore r
Cancel = False
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox Err.Description , vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Sub
Private Sub Form_Timer()
On Error GoTo Err_Handler
m_lngSeconds = m_lngSeconds + 1
If m_lngSeconds >= m_lngTimeout Then
Me.TimerInterva l = 0
ixp.Navigate2 "about
:blan k"
End If
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox Err.Description , vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Sub
Private Sub Form_Unload(Can cel As Integer)
On Error GoTo Err_Handler
If Not ixp Is Nothing Then
Set ixp = Nothing
End If
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox Err.Description , vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Sub
Private Sub ixp_DocumentCom plete(ByVal pDisp As Object, URL As Variant)
On Error GoTo Err_Handler
Dim strHtml As String
Dim lngPos1 As Long
Dim lngPos2 As Long
Dim strValue As String
If pDisp Is ixp Then
DoCmd.Hourglass False
Me.TimerInterva l = 0
If ixp.LocationURL = "about
:blan k" Then
MsgBox "Timeout Occurred!", vbExclamation
Else
strHtml = ixp.Document.Bo dy.innerHTML
Select Case m_QuestionType
Case QuestionTypeEnu m.CapitalQuesti on
lngPos1 = InStr(1, strHtml, ">The Capital of ")
Case QuestionTypeEnu m.PopulationQue stion
lngPos1 = InStr(1, strHtml, ">The Population of ")
End Select
If lngPos1 > 0 Then
lngPos1 = InStr(lngPos1, strHtml, "<P>")
If lngPos1 > 0 Then
lngPos1 = lngPos1 + 3
lngPos2 = InStr(lngPos1, strHtml, "</P>")
If lngPos2 > lngPos1 Then
strValue = Trim(Mid$(strHt ml, lngPos1, lngPos2 -
lngPos1))
End If
End If
End If
End If
If Len(strValue) > 0 Then
strValue = "Q: " & Me.txtQuestion & vbCrLf & _
"A: " & strValue
MsgBox strValue, vbInformation, "Answer"
Else
strValue = "Q: " & Me.txtQuestion & vbCrLf & _
"A: Sorry, I don't know!"
MsgBox strValue, vbExclamation, "Unanswered Question"
End If
End If
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox Err.Description , vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Sub
' *** Code Ends ***
