关于一个用VB编写的PING工具的问题

我在互联网上找到一个用VB编写的程序，是PING一个计算机的IP是否能通的工具，我改了改，使用ADO重数据库中循环读取IP地址，并将测试后的状态写入到数据库，作完后运行是可以测试，但是速度太慢了，每循环测试一个IP地址都需要接近1秒的时间，如果IP多的话时间就太长了，有其他办法让测试时间缩短吗？多线程如何做呢?谢谢各位帮忙！！！ VB代码： 
Option Explicit 
Private Const WS_VERSION_REQD As Long = &H101 
Private Const INADDR_NONE As Long = &HFFFFFFFF 
Private Const MAX_WSADescription As Long = 256 
Private Const MAX_WSASYSStatus As Long = 128 
Private Const PING_TIMEOUT As Long = 500 Private Type ICMP_OPTIONS 
  Ttl             As Byte 
  Tos             As Byte 
  Flags           As Byte 
  OptionsSize     As Byte 
  OptionsData     As Long 
End Type Private Type ICMP_ECHO_REPLY 
  Address         As Long 
  status          As Long 
  RoundTripTime   As Long 
  DataSize        As Long 
  DataPointer     As Long 
  Data            As String * 250 
End Type 
Private Type WSADATA 
  wVersion As Integer 
  wHighVersion As Integer 
  szDescription(0 To MAX_WSADescription) As Byte 
  szSystemStatus(0 To MAX_WSASYSStatus) As Byte 
  wMaxSockets As Long 
  wMaxUDPDG As Long 
  dwVendorInfo As Long 
End Type Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long 
    
Private Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, _ 
    ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Long, _ 
    ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, _ 
    ByVal Timeout As Long) As Long 
     
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, _ 
    lpWSADATA As WSADATA) As Long 
     
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, _ 
    ByVal dwHostLen As Long) As Long 
     
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ 
    (xDest As Any, xSource As Any, ByVal nbytes As Long) 
    
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal s As String) As Long 
     
Private Sub Command1_Click()    'ping网络计算机 
  Dim ECHO As ICMP_ECHO_REPLY 
  Dim pos As Long 
  Dim success As Long 
  Dim WSAD As WSADATA 
  Dim aa As Boolean 
  Dim mystr As String 
  Dim Cn As New ADODB.Connection 
  Dim Re As New ADODB.Recordset 
  Dim SqlStr As String 
  Dim Numb As Long 
  Set Cn = New ADODB.Connection 
  Set Re = New ADODB.Recordset 
  Cn.Open "Provider=Microsoft.jet.OLEDb.4.0;Data Source=F:\icmp device manager\db\ipdb.mdb" 
  Re.CursorLocation = adUseClient 
  SqlStr = "select * from ip_table " 
  Re.Open SqlStr, Cn, adOpenStatic, adLockOptimistic 
  Numb = Re.RecordCount 
  While Numb  < > 0 
  aa = WSAStartup(WS_VERSION_REQD, WSAD) = 0 
  If aa Then 
     Dim hPort As Long 
     mystr = inet_addr(Re("ipaddress").Value) 
     If mystr  < > INADDR_NONE Then 
        hPort = IcmpCreateFile() 
        If hPort Then 
           Call IcmpSendEcho(hPort, mystr, Text1.Text, Len(Text1.Text), _ 
                             0, ECHO, Len(ECHO), PING_TIMEOUT)     '发送回响请求报文，返回回响应答报文 
           Call IcmpCloseHandle(hPort) 
        End If 
        If ECHO.status = 0 Then 
          Re("status").Value = "1" 
          Re.Update 
        Else 
          Re("status").Value = "0" 
          Re.Update 
        End If 
     End If 
  End If 
  Re.MoveNext 
  Numb = Numb - 1 
  Wend 
  Re.Close 
  Text2.Text = "完成" 
End Sub