ExcelBanter - Test to see if a server is mapped

Termpy,

Here is a function adapted from some of Randy Birch's code. Use like

fnd = isdrivemapped("\\User-q87gfrgf6m2\Desktop")

to check if it is mapped

Private Const NERR_SUCCESS As Long = 0&
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_CONNECTED = &H1

Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type

Private Declare Function WNetOpenEnum Lib "mpr.dll" _
Alias "WNetOpenEnumA" _
(ByVal dwScope As Long, _
ByVal dwType As Long, _
ByVal dwUsage As Long, _
lpNetResource As Any, _
lphEnum As Long) As Long

Private Declare Function WNetEnumResource Lib "mpr.dll" _
Alias "WNetEnumResourceA" _
(ByVal hEnum As Long, _
lpcCount As Long, _
lpBuffer As Any, _
lpBufferSize As Long) As Long

Private Declare Function WNetCloseEnum Lib "mpr.dll" _
(ByVal hEnum As Long) As Long

Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenA" _
(ByVal lpString As Any) As Long

Private Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" _
(ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long

Function IsDriveMapped(mDrive As String)
Dim hEnum As Long
Dim bufptr As Long
Dim dwBuffSize As Long
Dim nStructSize As Long
Dim dwEntries As Long
Dim success As Long
Dim i As Long
Dim netRes() As NETRESOURCE
Dim sLocalName As String
Dim sUncName As String

success = WNetOpenEnum(RESOURCE_CONNECTED, _
RESOURCETYPE_ANY, 0&, ByVal 0&, hEnum)

If success = NERR_SUCCESS And _
hEnum < 0 Then

dwEntries = 1024
ReDim netRes(0 To dwEntries - 1) As NETRESOURCE

nStructSize = LenB(netRes(0))
dwBuffSize = 1024& * nStructSize

success = WNetEnumResource(hEnum, dwEntries, _
netRes(0), dwBuffSize)

If success = 0 Then
For i = 0 To dwEntries - 1
sLocalName = ""
sUncName = ""
If netRes(i).lpLocalName < 0 Then
sLocalName = GetStrFromPtrA(netRes(i).lpLocalName)
sLocalName = TrimNull(sLocalName)
End If

If netRes(i).lpRemoteName < 0 Then
sUncName = GetStrFromPtrA(netRes(i).lpRemoteName)
sUncName = TrimNull(sUncName)
End If

IsDriveMapped = sUncName = mDrive
If IsDriveMapped Then Exit Function

Next cnt
End If
End If

Call WNetCloseEnum(hEnum)
End Function

Public Function GetStrFromPtrA(ByVal lpszA As Long) As String
GetStrFromPtrA = String$(lstrlen(ByVal lpszA), 0)
Call lstrcpy(ByVal GetStrFromPtrA, ByVal lpszA)
End Function

Private Function TrimNull(item As String)
Dim iPos As Integer
iPos = InStr(item, Chr(0))
If iPos 0 Then
TrimNull = Left(item, iPos - 1)
Else
TrimNull = item
End If
End Function

--

HTH

RP
(remove nothere from the email address if mailing direct)

"Tempy" wrote in message
...
Good day, as a newbie i am not sure if this is possible ?
I run some code that asks the user to put in the file name and save it
but i need to first test and see if he is mapped to the server.
Secondly is it possible to map to a drive with a user name and password
and then save the file ?

Tempy

*** Sent via Developersdex http://www.developersdex.com ***