使用VB6 ADO将数据追加到Excel列
我正在testing从TextBox插入文本到Excel的示例VB6应用程序。 我想find列中最后一个使用的行，并且每当用户单击一个button时，在下一行添加txt1 TextBox的文本。 范围从C10到C49 。 最后一行填满后，我会提示用户打开新的Excel文件。
我无法做的追加部分。 下面是我试过的代码：
Private Sub cmdUpdate_Click() Dim objConn As New ADODB.Connection Dim szConnect As String szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=C:\Excel\Format.xls;" & _ "Extended Properties='Excel 8.0;HDR=NO';" objConn.Open szConnect Dim xrow As Integer Dim lastRow As Integer lastRow = 10 xrow = 49 Do while lastRow <= xrow objConn.Execute "UPDATE [Sheet1$C" & lastRow & ":C" & lastRow & "] SET F1 =" & txt1.Text & ";" lastRow = lastRow + 1 Loop End Sub
代码填充每个更新的整个范围。 我知道我的错误在哪里，但无法找出正确的方法。 如何使它只插入一次，直到第49行？
使用Excel对象模型不是一个选项，因为我希望能够在Excel中打开工作簿时进行更新。
简单的方法来实现这将是声明你的lastRow更可见（例如作为你的表单类的私有成员），放下循环，并增量lastRow每更新只有一次：
Private lastRow As Integer '... objConn.Execute _ "UPDATE [Sheet1$C" & lastRow & ":C" & lastRow _ & "] SET F1 =" & txt1.Text & ";" lastRow = lastRow + 1
如果你不能完全控制目标Excel范围（例如，范围内的数据可能会在你的更新之间被修改，而你不想覆盖这些更改），那么你可以在每次更新之前search第一个空单元格。 使用IsNull()来testing空单元格。
Private Const RANGE_IS_FULL As Long = -1 ' Returns first vacant position in sRange Excel range (zero-based) ' Returns RANGE_IS_FULL if no vacant position was found ' sConnectionString: connection string to Excel workbook ' sRange: Excel range of a form [Sheet1$C10:C49] Private Function GetNextAppendPosition(sConnectionString As String _ , sRange As String) As Long Dim lRow As Long Dim oRS As ADODB.Recordset Set oRS = New ADODB.Recordset oRS.CursorLocation = ADODB.adUseClient oRS.Open "SELECT F1 FROM " & sRange _ , sConnectionString oRS.MoveFirst GetNextAppendPosition = RANGE_IS_FULL lRow = -1 While Not oRS.EOF lRow = lRow + 1 If IsNull(oRS.Fields(0).Value) Then GetNextAppendPosition = lRow GoTo hExit End If oRS.MoveNext Wend hExit: oRS.Close End Function
考虑到这一点，你的更新例程可以这样编码：
Public Sub ExportTextToExcelRow(sText As String) Const CONNECTION_STRING As String = _ "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=C:\src\Excel ADO\Book1.xls;" & _ "Extended Properties='Excel 8.0;HDR=NO'; " Const MAX_TARGET_ROW As Long = 49 Const MIN_TARGET_ROW As Long = 10 Const TARGET_COL As String = "C" Const TARGET_SHEET As String = "Sheet1" Dim lRow As Long Dim oConn As New ADODB.Connection Dim sTargetRange As String sTargetRange = "[" & TARGET_SHEET & "$" & TARGET_COL & MIN_TARGET_ROW _ & ":" & TARGET_COL & MAX_TARGET_ROW & "]" lRow = GetNextAppendPosition(CONNECTION_STRING, sTargetRange) If lRow = RANGE_IS_FULL Then MsgBox "Oops, range is full." Exit Sub End If lRow = lRow + MIN_TARGET_ROW sTargetRange = "[" & TARGET_SHEET & "$" & TARGET_COL & lRow _ & ":" & TARGET_COL & lRow & "]" oConn.Open CONNECTION_STRING oConn.Execute "UPDATE " & sTargetRange & " SET F1 = """ & sText & """;" oConn.Close End Sub
用你的事件处理器来调用它：
Private Sub cmdUpdate_Click() ExportTextToExcelRow txt1.Text End Sub