使用VB6將數據追加到Excel列ADO

Question

我正在測試從TextBox插入文本到Excel的示例VB6應用程序。 我想查找列中最後一次使用的行，並且每當用戶單擊一個按鈕時在下一行添加文本框txt1。 範圍從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中打開工作簿時進行更新。

Answer 1

簡單的方式實現，這將是宣佈你lastRow更明顯（例如，作爲你的窗體類的私有成員），降循環，並增加lastRow只有一次每次更新：如果假設

Private lastRow As Integer 
'... 
objConn.Execute _ 
    "UPDATE [Sheet1$C" & lastRow & ":C" & lastRow _ 
    & "] SET F1 =" & txt1.Text & ";" 
lastRow = lastRow + 1 

沒有完全控制目標Excel範圍（例如，範圍中的數據可能會在更新之間進行修改，並且您不希望覆蓋這些更改），那麼您可以在每次更新之前搜索第一個空單元。使用IsNull()來測試空單元格。

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