Here's some code I pulled out of an old db. This must have been shortly
after I first started playing around with vba because I don't seemed to have
saved any information on where the code actually came from (I found it
somewhere, and I generally try to save at least the link to it if the author
didn't include copyright notes), so hopefully I don't get crucified for not
giving credit (if anyone happens to recognize the code and can point me to
the link I'll be sure to save it for future use, if its more than a few days
since this post email it to me because I'll probably loose track of the post
itself).
I *think* this is everything required, though the db that I pulled this from
had a module called modAPIs where I piled anything to do with an API (not
generally a good idea, being that I didn't document much about which
constants when to which apis, etc, etc).
Use at your own risk...
'CODE START
'Declarations for checking the Network Drive Available
Private Declare Function prn_WNetGetConnection _
Lib "mpr.dll" Alias "WNetGetConnectionA" _
(ByVal LocalName$, _
ByVal RemoteName$, _
cbRemoteName&) _
As Long
Private Declare Function prn_WNetAddConnection _
Lib "mpr.dll" Alias "WNetAddConnectionA" _
(ByVal NewPath$, _
Password, _
LocalName&) _
As Long
'Constants for Get/Add Network Connections
Const ERROR_NO_ERROR = 0
Const ERROR_ACCESS_DENIED = 5
Const ERROR_BAD_NETPATH = 53
Const ERROR_BAD_NET_NAME = 67
Const ERROR_ALREADY_ASSIGNED = 85
Const ERROR_INVALID_PASSWORD = 56
Const ERROR_MORE_DATE = 234
Const ERROR_INVALID_ADDRESS = 487
Const ERROR_BAD_DEVICE = 1200
Const ERROR_CONNECTION_UNAVAIL = 1201
Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202
Const ERROR_NO_NET_OR_BAD_PATH = 1203
Const ERROR_NO_NETWORK = 1222
Const ERROR_NOT_CONNECTED = 2250
'==============================================================================
'Checks to see if a drive or printer on the netwrok is available
'Accepts Drive as "C:", "LPT3:" or "\\Network_server\drive"
'Returns True(-1) on Success, False (0) on Faliur
'==============================================================================
Public Function at_CheckNet%(DriveOrPrinter$)
On Error GoTo Err_CN
Dim xMsg As String
Dim xBtns As Variant
Dim xTitle As String
'=========================
Dim dwError&
Dim RemoteNamesz&
Dim RemoteName$
'=========================
at_CheckNet = True
If InStr(DriveOrPrinter, "\\") < 1 Then 'local named resource
RemoteName = String(255, 0)
RemoteNamesz = Len(RemoteName)
dwError = prn_WNetGetConnection(DriveOrPrinter, RemoteName, RemoteNamesz)
If dwError = ERROR_CONNECTION_UNAVAIL Or _
dwError = ERROR_NOT_CONNECTED Or _
dwError = ERROR_NO_NETWORK Then
at_CheckNet = 0
End If
Else 'a network address is supplied to the function
'we supply a null password, which may be required & a null connection
'connection name, since we're not actually connecting, just checking
'the connection. Will return ERROR_DEVICE_ALREADY_REMEMBERED if
'available
dwError = prn_WNetAddConnection(DriveOrPrinter, Null, 0&)
If dwError = ERROR_NO_NETWORK Or _
dwError = ERROR_NOT_CONNECTED Or _
dwError = ERROR_CONNECTION_UNAVAIL Or _
dwError = ERROR_NO_NET_OR_BAD_PATH Or _
dwError = ERROR_ACCESS_DENIED Or _
dwError = ERROR_BAD_NETPATH Or _
dwError = ERROR_BAD_NET_NAME Or _
dwError = 1231 Then 'added
at_CheckNet = 0
End If
End If
'=========================
Exit_CN:
Exit Function
'=========================
Err_CN:
'Err Handling Here
Resume Exit_CN
Resume
End Function
'CODE END
--
Jack Leach
www.tristatemachine.com
- "A designer knows he has reached perfection not when there is nothing left
to add, but when there is nothing left to take away." - Antoine De Saint
Exupery
"J.J." wrote:
> Sorry Jack, while one of the subfunctions supposedly asks the exact question
> I am looking for, the code calls on a non-existent function. I keep coming
> accross another non-exixtent function in VB called GetIsNetworkAvailable.
> Any other ideas ?
Similar Threads
