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