Dim myConn As ADODB.Connection

我正在尝试几件事情，其中​​之一是将excel工作簿连接到AS400，以便在我们的系统中获得对部件号的描述，但试图保持连接处于打开状态，或者至less在工作簿closures之前。 有没有人有什么build议？

Public Sub GetPartNumbers() Dim myConn As ADODB.Connection Dim myRS As ADODB.Recordset '' Dim selVal As String '' Dim selRow As Integer Set myConn = New ADODB.Connection myConn.ConnectionString = "Provider=SEQUEL ViewPoint;" myConn.Open Set myRS = New ADODB.Recordset 

Answer 1

这是我如何做到的。

 Dim myConn As New ADODB.Connection Dim myRs As New ADODB.Recordset On Error GoTo ErrorHandler con.Open "PROVIDER=IBMDAS400;Data Source=999.999.999.999;USER ID= ;PASSWORD= ;" Set myRs.ActiveConnection = myConn End Exit Sub ErrorHandler: MsgBox "Can not connect", vbInformation, cHeading End End Sub 

Answer 2

我可以同情你，因为在我知道很多关于VBA之前，我必须弄清楚这一点。 下面是一个简单的连接和循环结果的例子。 是的，你不应该使用激活，但为了这个例子我通过它。

请注意，您应该清理最后的连接。 如果使用error handling程序，则确保在退出之前closures任何打开的连接，即使出现错误也是如此。

 Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Set cnn = New ADODB.Connection Set rst = New ADODB.Recordset cnn.Open "PROVIDER=IBMDAS400;Data Source=999.999.999.999;USER ID= ;PASSWORD= ;" rst.ActiveConnection = cnn rst.CursorLocation = adUseServer 'Query String (Specific to your database setup) rst.Source = "SELECT DISTINCT F3002.IXLITM " _ & "FROM WYATT.PRDDTA.F3002 F3002 " _ & "WHERE (F3002.IXKITL='30P') AND (F3002.IXTBM='E')" rst.Open Worksheets("Sheet1").Range("A1").Activate Do Until rst.EOF ActiveCell.Value = rst.Fields("IXLITM") rst.MoveNext ActiveCell.Offset(1, 0).Activate Loop 'Clean up rst.Close Set rst = Nothing Set cnn = Nothing