Question

我正在测试一个示例VB6应用程序，它将TextBox中的文本插入到Excel中。我想在列中找到最后使用的行，并在用户单击按钮时在下一行的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中打开工作簿时进行更新。

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

使用VB6 ADO将数据附加到Excel列

1 个答案: