<DIV style="FONT-SIZE: 14px; COLOR: #138; LINE-HEIGHT: 150%"><FONT face=Verdana><FONT color=#000000><b>上一贴有错!</b>
下面的代码在Win2000+SQL2000+Access2002下修改后并测试通过:
</FONT>
<FONT face=Courier>Sub MakeAdpConnectionless()
</FONT><FONT face=Courier><FONT color=#006600>'断开当前adp的连接
'
</FONT>
Application.CurrentProject.CloseConnection <FONT color=#006000>'关闭连接</FONT>
Application.CurrentProject.OpenConnection </FONT><FONT face=Courier><FONT color=#006000>'将连接设置为无
</FONT>
End Sub
Public Function sCreateConnection(ByVal UDLFileName As String) As String
</FONT><FONT face=Courier><FONT color=#006000>'********************************************************************
'该函数在adp中检查连接,如果没有,它将通过输入参数创建一个连接
'
'输入:
' udlfilename: 通用数据连接文件名
'输出:
' 连接状态
'
'********************************************************************
</FONT>On Error GoTo sCreateConnectionTrap:
Dim sConnectionString As String
If Application.CurrentProject.BaseConnectionString = "" Then
</FONT><FONT face=Courier><FONT color=#006000>'表示adp处于无连接状态
</FONT>
sConnectionString = GetConnectionStringFromUDL(CurrentProject.Path & "\" & UDLFileName)
Application.CurrentProject.OpenConnection sConnectionString
sCreateConnection = "创建了使用 udl 文件 (" & UDLFileName & ")连接到数据库的连接!"
Else <FONT color=#006000>'连接已存在</FONT>
sCreateConnection = "已经存在数据库的连接!"
End If
sCreateConnectionExit:
Exit Function
sCreateConnectionTrap:
sCreateConnection = Err.Description
Resume sCreateConnectionExit
End Function
Public Function GetConnectionStringFromUDL(ByVal UDLFileName As String) As String
Dim sLine As String
Dim FileNo As Integer
If Len(Trim(Dir(UDLFileName & ""))) > 0 Then
FileNo = FreeFile
Open UDLFileName For Input As #FileNo
Do While Left(LCase(sLine), 8) <> "provider" And Not EOF(FileNo)
Line Input #FileNo, sLine
Loop
If Left(LCase(sLine), 8) <> "provider" Then
GetConnectionStringFromUDL = "0"
Else
GetConnectionStringFromUDL = sLine
End If
Close #FileNo
Else
GetConnectionStringFromUDL = "0"
End If
End Function
</FONT></FONT></DIV>
[此贴子已经被作者于2005-10-21 11:08:08编辑过]
|