如何从udl文件中取出BaseConnectionString信息？

renzhm

使用Access的ADP，已创建了连接，但考虑到分发时服务器的不固定情况，
创建了udl文件作为连接，不知如何更改当前的连接？

我的代码：
Public Sub OpenAstLink()
  On Error GoTo Except
    Dim ConnStr As String
    ConnStr = "File Name=" & CurrentProject.Path & "\ast.udl;"
    Dim Conn As ADODB.Connection
    Set Conn = New ADODB.Connection
    Conn.Open ConnStr
   
    CurrentProject.CloseConnection
    CurrentProject.OpenConnection  '使当前工程连接无状态
    DoCmd.RunCommand acCmdConnection '这里会弹出配置窗口，我想可不可以使用上面的连接Conn对象，或自己创建连接

    Exit Sub

Except:
   MsgBox "数据库连接异常"
   
End Sub
----------------------------
当然，使用CurrentProject.OpenConnection "rovider=SQLOLEDB.1ersist Security Info=False;User ID=sa;Initial Catalog=AST;Data Source=QSB"

可以满足我的要求，但必须使用文件来存储这样的信息，我想使用udl文件，方便
配置和测试连接，所以如果能从udl文件中取出BaseConnectionString信息，也就
解决了问题。

我察过以前的帖子，都没有很好的解决此问题！

zhuyiwen

<>下面的两个函数：
一、MakeADPConnectionless: 用于断开当前ADP的连接，使 BaseConnectionString 为空，一般用在项目退出的时候。

二、sCreateConnection: 用于使用 udl 文件创建当前 ADP 的数据库连接，即：BaseConnectionString，使当前的ADP连接到 udl 文件指定SQL数据库，一般用进入项目时。

<FONT face="Courier New">Sub MakeADPConnectionless()
<FONT color=#008000>'断开当前ADP的连接
'
</FONT>
    Application.CurrentProject.CloseConnection  '关闭连接
    Application.CurrentProject.OpenConnection   '将连接设置为无

End Sub

Public Function sCreateConnection( Byval udlFileName As String) As String
<FONT color=#008000>'********************************************************************
'该函数在ADP中检查连接，如果没有，它将通过输入参数创建一个连接
'
'输入:
' udlFileName: 通用数据连接文件名
'输出:
' 连接状态
'
'********************************************************************
</FONT>
On Error GoTo sCreateConnectionTrap:

    Dim sConnectionString As String

    If Application.CurrentProject.BaseConnectionString = "" Then
    <FONT color=#008000>'表示ADP处于无连接状态</FONT>
   
        sConnectionString = "File Name=" &amp; _
                        CurrentProject.Path &amp; udlFileName
        
        Application.CurrentProject.OpenConnection sConnectionString
        sCreateConnection = "创建了使用 udl 文件 （" &amp; _
                      udlFileName &amp; "）连接到数据库的连接!"
   
    Else <FONT color=#008000>'连接已存在</FONT>
        
        sCreateConnection = "已经存在数据库的连接!"
   
    End If


sCreateConnectionExit:
    Exit Function

sCreateConnectionTrap:
    sCreateConnection = Err.Description
    Resume sCreateConnectionExit

End Function
</FONT></P>

[此贴子已经被作者于2005-1-28 22:09:35编辑过]

renzhm

谢谢，高手出现果然不同凡响！我还以为baseconnectionstring不能使用udl呢！

renzhm

刚才试验了一下，真的不行：
这样可以
application.currentproject.openconnection
“Provider=SQLOLEDB.1ersist Security Info=False;User ID=sa;Initial Catalog=AST;Data Source=QSB“

但是这样不行
application.currentproject.openconnection "file name=" & currentproject.path & udlfilename

不知道为什么？
        

zhuyiwen

<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 &amp; "\" &amp; UDLFileName)
        
        Application.CurrentProject.OpenConnection sConnectionString
        sCreateConnection = "创建了使用 udl 文件 （" &amp; UDLFileName &amp; "）连接到数据库的连接!"
   
    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 &amp; ""))) &gt; 0 Then
        FileNo = FreeFile
        Open UDLFileName For Input As #FileNo
        Do While Left(LCase(sLine), 8) &lt;&gt; "provider" And Not EOF(FileNo)
            Line Input #FileNo, sLine
        Loop
        If Left(LCase(sLine), 8) &lt;&gt; "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编辑过]

renzhm

to zhuyiwen :

真是太感谢您了！调试通过了，怎么感谢您呢？这里又不能给分！