使用VBA的新数据库连接

时间:2017-01-30 11:32:01

标签: vba connection

Sub DBconnection()

Dim C           As Integer
Dim ambiente    As String
Dim userid      As String
Dim password    As String
Dim Query       As String
Dim Newsht      As Worksheet
Dim Conn        As ADODB.Connection
Dim Rcrdst      As ADODB.Recordset

Set Newsht = ActiveWorkbook.Sheets("sheet1")
userid = InputBox("Please insert your USER ID for CSDG4 environment.", "Test")
password = InputBox("Please insert the PASSWORD related to " & userid & " user.", "Test")
ambiente = "CSDG4"

If userid <> "" And password <> "" Then
    Set Conn = New ADODB.Connection
    Conn.ConnectionString = "Provider=MSDAORA; Password= " & password & ";User ID= " & userid & "; Data Source = " & ambiente & ";Persist Security Info=True"
    Conn.Open
    Query = "select seq_prenotazione, cod_rapporto,stato_pren from via.prenotazione where seq_prenotazione in (700016298527, 700016761977);"

    Set Rcrdst = New ADODB.Recordset
    Rcrdst.CursorLocation = adUseClient
    Rcrdst.CursorType = adOpenStatic
    Rcrdst.LockType = adLockBatchOptimistic

    Rcrdst.Source = Query
    Rcrdst.ActiveConnection = Conn
    Rcrdst.Open

我正在尝试使用VBA打开一个新连接但声明&#34; Rcrdst.Open&#34;给我错误如下

Error

1 个答案:

答案 0 :(得分:0)

不是这样的答案,但是你正在使用的对象,你的连接和记录集,都有在连接/数据操作等过程中发生的事件。所以个人来说,在学习这样的新东西时,我把它们包装成我自己的帮助陷阱发生错误的类。例如,这没有经过测试,但是对于ADO,我会使用像这样的类,clsADOTest,代码

Option Explicit

Private WithEvents CONN As ADODB.Connection         '   Allow us to couple code we write to the events of an object
Private WithEvents rst As ADODB.Recordset
Private strUserID As String
Private strPwd As String

Public Property Let UserName(strUserName As String)
    strUserID = strUserName
End Property
Public Property Let Password(strPassword As String)
    strPwd = strPassword
End Property

Public Property Let ConnectionString(strConnectionString As String)
    CONN.ConnectionString = strConnectionString
End Property

Public Sub class_initialize()
    Set CONN = New ADODB.Connection
End Sub

Private Sub Class_Terminate()
    If Not CONN Is Nothing Then
        If CONN.State <> adStateClosed Then
            CONN.Close
        End If
        Set CONN = Nothing
    End If
End Sub

'   Simulated ADO Methods
'   Wrappers round existing ADO Methods used in SO question

Public Function OPEN_CONNECTION() As Boolean
On Error GoTo eHandle
If Not CONN Is Nothing Then
    CONN.Open
End If
OPEN_CONNECTION = True
Exit Function
eHandle:
    OPEN_CONNECTION = False
End Function

Public Function EXECUTE_SQL(strSQL As String) As ADODB.Recordset
    Set EXECUTE_SQL = CONN.Execute(strSQL)
End Function

Public Function CLOSE_CONNECTION() As Boolean
If Not CONN Is Nothing And CONN.State <> adStateClosed Then
    CONN.Close
End If
End Function

'   ADO Events
Private Sub CONN_ConnectComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)

If Not pError Is Nothing Then
    MsgBox "Error in connection"
Else
    Debug.Print "Connected to " & pConnection.ConnectionString
End If

End Sub

Private Sub CONN_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, _
                            adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, _
                            ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)

If Not pError Is Nothing Then
    MsgBox "Error in SQL"
Else
    If Not pRecordset Is Nothing Then
        Debug.Print pRecordset.RecordCount & " records returned from " & pCommand.CommandText
    Else
        Debug.Print "Execute complete"
    End If
End If

End Sub

这会给我一个在VBA中使用的对象,我可以在不同阶段看到,导致错误和纠正的原因。

所以你可以用这样的东西作为你的例子。做一些关于事件的阅读,并查看ADO连接的MSDN页面等,看看你可以从这些事件中收集到什么。

Sub testing()

Dim ADOClass As New clsADOTest
Dim rst As ADODB.Recordset

With ADOClass

    .UserName = InputBox("Please insert your USER ID for CSDG4 environment.", "Test")
    .Password = InputBox("Please insert the PASSWORD related to " & .UserName & " user.", "Test")
    .ConnectionString = ""

    If .OPEN_CONNECTION Then
        Set rst = ADOClass.EXECUTE_SQL("select seq_prenotazione, cod_rapporto,stato_pren from.....")
    Else

    End If

End With

Set ADOClass = Nothing

End Sub