引用ADO和microsoft ole db service component 1.0 libary参考如下代码 Option Explicit Dim adoConn As ADODB.Connection Private Function BuildAdoConnection(ByVal ConnectionString As String) As String ' display the ADO Connection Window (ADO DB Designer) Dim dlViewConnection As MSDASC.DataLinks On Error GoTo Err_BuildAdoConnection
If Not (Trim$(ConnectionString) = "") Then Set adoConn = New ADODB.Connection adoConn.ConnectionString = ConnectionString Set dlViewConnection = New MSDASC.DataLinks dlViewConnection.hWnd = Me.hWnd If dlViewConnection.PromptEdit(adoConn) Then BuildAdoConnection = adoConn.ConnectionString Else BuildAdoConnection = ConnectionString End If Set dlViewConnection = Nothing Set adoConn = Nothing Else Set dlViewConnection = New MSDASC.DataLinks dlViewConnection.hWnd = Me.hWnd Set adoConn = dlViewConnection.PromptNew BuildAdoConnection = adoConn.ConnectionString Set dlViewConnection = Nothing Set adoConn = Nothing End IfExit_BuildAdoConnection: On Error Resume Next If Not (adoConn Is Nothing) Then Set adoConn = Nothing End If If Not (dlViewConnection Is Nothing) Then Set dlViewConnection = Nothing End If On Error GoTo 0 Exit FunctionErr_BuildAdoConnection: Select Case Err Case 0 Resume Next Case -2147217805 adoConn.ConnectionString = "" Resume Case 91 Resume Exit_BuildAdoConnection Case Else MsgBox "Error: " & Err.Number & vbCrLf & vbCrLf & Err.Description, vbInformation, App.Title & " - Advisory" Resume Exit_BuildAdoConnection End Select
End Function Private Sub Command1_Click() Set adoConn = New ADODB.Connection Dim strAdoConn As String strAdoConn = BuildAdoConnection("") 'strAdoConn 为连接字符串 MsgBox strAdoConn End Sub
Set objDataLink = New MSDASC.DataLinks
sConnect = objDataLink.PromptNew
microsoft ole db service component 1.0 type .......
或者你在程序中写入几种数据库驱动名(数据库驱动无非就这么几种吗!例如:SQL Server、Oracle、Access2000/97、VFP等等或IBM的CliendAccess)。
Option Explicit
Dim adoConn As ADODB.Connection
Private Function BuildAdoConnection(ByVal ConnectionString As String) As String ' display the ADO Connection Window (ADO DB Designer) Dim dlViewConnection As MSDASC.DataLinks On Error GoTo Err_BuildAdoConnection
If Not (Trim$(ConnectionString) = "") Then
Set adoConn = New ADODB.Connection
adoConn.ConnectionString = ConnectionString
Set dlViewConnection = New MSDASC.DataLinks
dlViewConnection.hWnd = Me.hWnd
If dlViewConnection.PromptEdit(adoConn) Then
BuildAdoConnection = adoConn.ConnectionString
Else
BuildAdoConnection = ConnectionString
End If
Set dlViewConnection = Nothing
Set adoConn = Nothing
Else
Set dlViewConnection = New MSDASC.DataLinks
dlViewConnection.hWnd = Me.hWnd
Set adoConn = dlViewConnection.PromptNew
BuildAdoConnection = adoConn.ConnectionString
Set dlViewConnection = Nothing
Set adoConn = Nothing
End IfExit_BuildAdoConnection: On Error Resume Next
If Not (adoConn Is Nothing) Then
Set adoConn = Nothing
End If
If Not (dlViewConnection Is Nothing) Then
Set dlViewConnection = Nothing
End If
On Error GoTo 0
Exit FunctionErr_BuildAdoConnection: Select Case Err
Case 0
Resume Next
Case -2147217805
adoConn.ConnectionString = ""
Resume
Case 91
Resume Exit_BuildAdoConnection
Case Else
MsgBox "Error: " & Err.Number & vbCrLf & vbCrLf & Err.Description, vbInformation, App.Title & " - Advisory"
Resume Exit_BuildAdoConnection
End Select
End Function
Private Sub Command1_Click()
Set adoConn = New ADODB.Connection
Dim strAdoConn As String
strAdoConn = BuildAdoConnection("") 'strAdoConn 为连接字符串
MsgBox strAdoConn
End Sub