EnumRAS

Const ERROR_SUCCESS = 0&
Const ERROR_BUFFER_TOO_SMALL = 603&
Const RAS_MaxEntryName = 256

Private Type RASENTRYNAME
dwSize As Long
szEntryName(RAS_MaxEntryName) As Byte
End Type
Private Declare Function RasEnumEntries Lib "RasApi32.DLL" Alias _
"RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, _
lpRasEntryName As Any, lpcb As Long, lpcEntries As Long) As Long

' Enumerate available RAS phone-book entries

' returns their name in a collection.

'

' the optional argument is the phonebook name

' Windows 9x: this argument is always ignored

' Windows NT, if omitted it uses the default phonebook

' Windows 2000, if omitted entries are enumerated from all

' the remote access phone-book files in the AllUsers profile

' and the user's profile.


Function EnumRASEntries(Optional ByVal PhoneBook As String) As Collection
Dim lpRasEntryName() As RASENTRYNAME
Dim retCode As Long
Dim cbBuf As Long
Dim cEntries As Long
Dim i As Integer

' prepare the result

Set EnumRASEntries = New Collection

' NULL is different from an empty string

If Len(PhoneBook) = 0 Then PhoneBook = vbNullString

' only one entry, just to check how many entries are there

ReDim lpRasEntryName(0) As RASENTRYNAME
lpRasEntryName(0).dwSize = LenB(lpRasEntryName(0))
cbBuf = lpRasEntryName(0).dwSize
retCode = RasEnumEntries(vbNullString, PhoneBook, lpRasEntryName(0), cbBuf, _
cEntries)

' read all entries, if more than just one

If retCode = ERROR_BUFFER_TOO_SMALL Then
ReDim lpRasEntryName(cEntries - 1) As RASENTRYNAME
lpRasEntryName(0).dwSize = LenB(lpRasEntryName(0))
cbBuf = cEntries * lpRasEntryName(0).dwSize
retCode = RasEnumEntries(vbNullString, PhoneBook, lpRasEntryName(0), _
cbBuf, cEntries)
End If

' an error occurred

If retCode <> ERROR_SUCCESS Then Err.Raise vbObjectError + 512, , _
"RasEnumEntries returnet " & retCode

' fill the result collection with entry names

For i = 0 To cEntries - 1
EnumRASEntries.Add StrConv(lpRasEntryName(i).szEntryName(), vbUnicode)
Next i

End Function