Winsock Component - Using with VBA
Retrieving web page source, using OstroSoft Winsock Component (oswinsck.dll)
Download project samples (Excel and Access)
Minimum requirements: MS Office 2000 (Access or Excel), oswinsck.dll*
* If you don't have OstroSoft Winsock Component, see installation instructions
1. Open Access database, go to Forms tab and create a new Form.
2. Add controls to the form: txtSource (TextBox), cmdView (CommandButton), txtURL (TextBox), Label1 (Label)
3. Right-click cmdView and select "Buld Event".
4. In VBA editor select Tools menu, then References submenu.
5. From the list of references select and check OSWINSCK, click OK button to save changes.
6. Enter the following code:
Option Explicit
Dim sPage As String
Dim WithEvents wsTCP As OSWINSCK.Winsock
Private Sub cmdView_Click()
On Error GoTo ErrHandler
Dim sServer As String
Dim nPort As Long
nPort = 80
sServer = Trim(txtURL)
If InStr(sServer, "://") > 0 Then _
sServer = Mid(sServer, InStr(sServer, "://") + 3)
If InStr(sServer, "/") > 0 Then
sPage = Mid(sServer, InStr(sServer, "/") + 1)
sServer = Left(sServer, InStr(sServer, "/") - 1)
End If
If InStr(sServer, ":") > 0 Then
nPort = Mid(sServer, InStr(sServer, ":") + 1)
sServer = Left(sServer, InStr(sServer, ":") - 1)
End If
If sServer = "" Then Err.Raise 12001, , "Invalid URL"
Set wsTCP = CreateObject("OSWINSCK.Winsock")
wsTCP.Connect sServer, nPort
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub
Private Sub wsTCP_OnClose()
wsTCP.CloseWinsock
End Sub
Private Sub wsTCP_OnConnect()
wsTCP.SendData "GET /" & sPage & " HTTP/1.0" & vbCrLf & vbCrLf
End Sub
Private Sub wsTCP_OnDataArrival(ByVal bytesTotal As Long)
Dim sBuffer As String
wsTCP.GetData sBuffer
txtSource = txtSource & sBuffer
End Sub
Private Sub wsTCP_OnError(ByVal Number As Integer, _
Description As String, ByVal Scode As Long, ByVal Source As String, _
ByVal HelpFile As String, ByVal HelpContext As Long, _
CancelDisplay As Boolean)
MsgBox Number & ": " & Description
End Sub
Private Sub wsTCP_OnStatusChanged(ByVal Status As String)
Debug.Print Status
End Sub
|
