新建From1（窗体），新建Command1（按钮CommandButton），List1（ListBox）代码：

Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
    (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, _
    cbRemoteName As Long) As Long
Private Const NO_ERROR = 0
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Const MAX_PATH = 260

Private Sub Command1_Click()   '监测网络驱动器
  Dim drv As Integer
  Dim nRet As Long
  Dim lpl As String
  Dim Dbg As String
  Dim lpr As String
  Dim cbr As Long
  List1.Clear      '清空列表
  For drv = Asc("C") To Asc("Z")   '设置驱动器范围
      If Len(Chr(drv)) Then
         lpl = UCase(Left(Chr(drv), 1)) & ":"
         lpr = Space(MAX_PATH)
         cbr = Len(lpr)
         nRet = WNetGetConnection(lpl, lpr, cbr)
         If nRet = ERROR_MORE_DATA Then
            lpr = Space(cbr)
            nRet = WNetGetConnection(lpl, lpr, cbr)
         End If
         If nRet = NO_ERROR Then
            List1.AddItem Chr(drv) & ":  " & Left(lpr, InStr(lpr, vbNullChar) - 1)  '将网络驱动器添加到列表
         End If
      End If
  Next drv
  Label2.Caption = "共有网络驱动器：" & List1.ListCount & "  个"
End Sub