一般是能过映射的办法... '--------------------------------------- 例如: If Left$(P_DbCode, 2) = "\\" Then '如果是网络路径 TmpPath = FilePath(P_DbCode) '从文件中取路径名. DisNet "M:" '不管存不存在,连接前先断开一次 DoEvents '映射连接 MapDriv "M:", Left(TmpPath, Len(TmpPath) - 1), P_UserLog.NetPwd, P_UserLog.NetUser Call Wait(5) End If '*****模块代码******** Option ExplicitPrivate Type NETRESOURCE dwScope As Long dwType As Long dwDisplayType As Long dwUsage As Long lpLocalName As String lpRemoteName As String lpComment As String lpProvider As String End TypeConst NO_ERROR = 0 Const CONNECT_UPDATE_PROFILE = &H1Const RESOURCETYPE_DISK = &H1 Const RESOURCETYPE_PRINT = &H2 Const RESOURCETYPE_ANY = &H0 Const RESOURCE_CONNECTED = &H1 Const RESOURCE_REMEMBERED = &H3 Const RESOURCE_GLOBALNET = &H2 Const RESOURCEDISPLAYTYPE_DOMAIN = &H1 Const RESOURCEDISPLAYTYPE_GENERIC = &H0 Const RESOURCEDISPLAYTYPE_SERVER = &H2 Const RESOURCEDISPLAYTYPE_SHARE = &H3 Const RESOURCEUSAGE_CONNECTABLE = &H1 Const RESOURCEUSAGE_CONTAINER = &H2Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" _ (lpNetResource As NETRESOURCE, _ ByVal lpPassword As String, _ ByVal lpUserName As String, _ ByVal dwFlags As Long) As LongPrivate Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" _ (ByVal lpName As String, _ ByVal dwFlags As Long, _ ByVal fForce As Long) As LongPublic Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _ (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _ (ByVal lpBuffer As String, nSize As Long) As Long '返回网络资源的UNC路径 Public Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _ (ByVal lpszLocalName As String, _ ByVal lpszRemoteName As String, _ cbRemoteName As Long) As Long Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long ''记录操作员登录信息 Public Type UserLog ID As String '操作员ID Name As String '操作员名称 PassWord As String '操作员密码 LogDate As Date '登录日期 LogTime As Date '登录时间 NetUser As String NetPwd As String End TypePublic P_DbCtrl As New SmDbCtrl Public P_Cnn As New ADODB.Connection Public P_WorkPath As String Public P_DbCode As String Public P_UserLog As UserLog' '取路径名 '函数:FilePath '参数: Fname 文件绝对路径. '返回值:路径名. '如:"C:\PROMAS\AA.EXE",则返回 "C:\PROMAS\" Public Function FilePath(Fname As String) As String Dim A As Integer Dim B As Integer Dim JlStr As String FilePath = "" B = 0 For A = Len(Fname) To 1 Step -1 If Mid$(Fname, A, 1) = "\" Then B = A: GoTo 100 End If Next A100:
JlStr = Left$(Fname, B) FilePath = JlStr End Function '建立和断开网络映射,取工作站名称及用户名称 '------------------------------------------ '1.MapDriv '**建立网络映射** _ NETFLAG=MapDriv(DrivName, NetPath,Password, UserName)'参数说明: _ DrivName 映射成的本地驱动器名 _ NetPath 网络路径 _ Password 密码(如果没有则用"") _ UserName 用户名(如果没有则用"") _'返回值 =TRUE 连接成功,=FALSe 连接失败 '------------------------------------------ '2.DisNet '**断开网络驱动器** _ FLAG=DisNet(NetDriv) _ NetDriv 断开的网络驱动器名 _'返回值 =True 成功,=False 失败 '----------------------------------------- '3.ComputerName '**返回本工作站名称** _ ComName = ComputerName()'返回值: 本机名称 '----------------------------------------- '4.UserName '**返回当前用户名称** _ UserName() As String ' '返回值: 网络登录者名称 '----------------------------------------'**建立网络映射** 'NETFLAG=MapDriv(DrivName, NetPath,Password, UserName)'参数说明: 'DrivName 映射成的本地驱动器名 'NetPath 网络路径 'Password 密码(如果没有则用"") 'UserName 用户名(如果没有则用"") '返回值 =TRUE 成功连接,=FALSe 连接失败 '============================================ Public Function MapDriv(DrivName As String, NetPath As String, PassWord As String, UserName As String) As Boolean '建立网络连接 Dim NetR As NETRESOURCE Dim ErrInfo As Long With NetR .dwScope = RESOURCE_GLOBALNET .dwType = RESOURCETYPE_DISK .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE .dwUsage = RESOURCEUSAGE_CONNECTABLE .lpLocalName = UCase(DrivName) '映射成本机盘符 .lpRemoteName = UCase(NetPath) '映射的网络路径 End With '建立连接,返回ERR代码 ErrInfo = WNetAddConnection2(NetR, PassWord, UserName, 0) '检查代码 MapDriv = (ErrInfo = NO_ERROR) End Function ''**断开网络驱动器** 'FLAG=DisNet(NetDriv) 'NetDriv 断开的网络驱动器名 '返回值 =True 成功,=False 失败 '===================================== Public Function DisNet(NetDriv As String) As Boolean Dim ErrInfo As Long Dim ErrRe As Long Dim strLocalName As String strLocalName = UCase(NetDriv) '断开的映射盘 '断开,返回ERR代码 ErrRe = WNetCancelConnection(strLocalName, True) ErrInfo = WNetCancelConnection2(strLocalName, CONNECT_UPDATE_PROFILE, True) '检查代码 If ErrInfo = NO_ERROR Then DisNet = True Else DisNet = False End If End Function '
一般是能过映射的办法...
'---------------------------------------
例如: If Left$(P_DbCode, 2) = "\\" Then '如果是网络路径
TmpPath = FilePath(P_DbCode) '从文件中取路径名.
DisNet "M:" '不管存不存在,连接前先断开一次
DoEvents
'映射连接
MapDriv "M:", Left(TmpPath, Len(TmpPath) - 1), P_UserLog.NetPwd, P_UserLog.NetUser
Call Wait(5)
End If
'*****模块代码********
Option ExplicitPrivate Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End TypeConst NO_ERROR = 0
Const CONNECT_UPDATE_PROFILE = &H1Const RESOURCETYPE_DISK = &H1
Const RESOURCETYPE_PRINT = &H2
Const RESOURCETYPE_ANY = &H0
Const RESOURCE_CONNECTED = &H1
Const RESOURCE_REMEMBERED = &H3
Const RESOURCE_GLOBALNET = &H2
Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Const RESOURCEDISPLAYTYPE_GENERIC = &H0
Const RESOURCEDISPLAYTYPE_SERVER = &H2
Const RESOURCEDISPLAYTYPE_SHARE = &H3
Const RESOURCEUSAGE_CONNECTABLE = &H1
Const RESOURCEUSAGE_CONTAINER = &H2Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" _
(lpNetResource As NETRESOURCE, _
ByVal lpPassword As String, _
ByVal lpUserName As String, _
ByVal dwFlags As Long) As LongPrivate Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" _
(ByVal lpName As String, _
ByVal dwFlags As Long, _
ByVal fForce As Long) As LongPublic Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
'返回网络资源的UNC路径
Public Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
(ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
cbRemoteName As Long) As Long
Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long
''记录操作员登录信息
Public Type UserLog
ID As String '操作员ID
Name As String '操作员名称
PassWord As String '操作员密码
LogDate As Date '登录日期
LogTime As Date '登录时间
NetUser As String
NetPwd As String
End TypePublic P_DbCtrl As New SmDbCtrl
Public P_Cnn As New ADODB.Connection
Public P_WorkPath As String
Public P_DbCode As String
Public P_UserLog As UserLog'
'取路径名
'函数:FilePath
'参数: Fname 文件绝对路径.
'返回值:路径名.
'如:"C:\PROMAS\AA.EXE",则返回 "C:\PROMAS\"
Public Function FilePath(Fname As String) As String
Dim A As Integer
Dim B As Integer
Dim JlStr As String
FilePath = ""
B = 0
For A = Len(Fname) To 1 Step -1
If Mid$(Fname, A, 1) = "\" Then
B = A: GoTo 100
End If
Next A100:
JlStr = Left$(Fname, B)
FilePath = JlStr
End Function
'建立和断开网络映射,取工作站名称及用户名称
'------------------------------------------
'1.MapDriv
'**建立网络映射** _
NETFLAG=MapDriv(DrivName, NetPath,Password, UserName)'参数说明: _
DrivName 映射成的本地驱动器名 _
NetPath 网络路径 _
Password 密码(如果没有则用"") _
UserName 用户名(如果没有则用"") _'返回值 =TRUE 连接成功,=FALSe 连接失败
'------------------------------------------
'2.DisNet
'**断开网络驱动器** _
FLAG=DisNet(NetDriv) _
NetDriv 断开的网络驱动器名 _'返回值 =True 成功,=False 失败
'-----------------------------------------
'3.ComputerName
'**返回本工作站名称** _
ComName = ComputerName()'返回值: 本机名称
'-----------------------------------------
'4.UserName
'**返回当前用户名称** _
UserName() As String
'
'返回值: 网络登录者名称
'----------------------------------------'**建立网络映射**
'NETFLAG=MapDriv(DrivName, NetPath,Password, UserName)'参数说明:
'DrivName 映射成的本地驱动器名
'NetPath 网络路径
'Password 密码(如果没有则用"")
'UserName 用户名(如果没有则用"")
'返回值 =TRUE 成功连接,=FALSe 连接失败
'============================================
Public Function MapDriv(DrivName As String, NetPath As String, PassWord As String, UserName As String) As Boolean
'建立网络连接
Dim NetR As NETRESOURCE
Dim ErrInfo As Long With NetR
.dwScope = RESOURCE_GLOBALNET
.dwType = RESOURCETYPE_DISK
.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
.dwUsage = RESOURCEUSAGE_CONNECTABLE
.lpLocalName = UCase(DrivName) '映射成本机盘符
.lpRemoteName = UCase(NetPath) '映射的网络路径
End With
'建立连接,返回ERR代码
ErrInfo = WNetAddConnection2(NetR, PassWord, UserName, 0)
'检查代码
MapDriv = (ErrInfo = NO_ERROR)
End Function
''**断开网络驱动器**
'FLAG=DisNet(NetDriv)
'NetDriv 断开的网络驱动器名
'返回值 =True 成功,=False 失败
'=====================================
Public Function DisNet(NetDriv As String) As Boolean
Dim ErrInfo As Long
Dim ErrRe As Long
Dim strLocalName As String
strLocalName = UCase(NetDriv) '断开的映射盘
'断开,返回ERR代码
ErrRe = WNetCancelConnection(strLocalName, True)
ErrInfo = WNetCancelConnection2(strLocalName, CONNECT_UPDATE_PROFILE, True)
'检查代码
If ErrInfo = NO_ERROR Then
DisNet = True
Else
DisNet = False
End If
End Function
'