1

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

4

1 回答 1

0

实现这一点的简单方法是将您声明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
于 2013-04-13T10:28:48.250 回答