Append data to Excel column using VB6 ADO - excel

Question

I am testing a sample VB6 application which inserts text from TextBox to Excel.
I would like to find the last used row in the column, and append text from txt1 TextBox at the next row whenever user clicks a button.
The range is from C10 to C49.
After the last row is filled, I will prompt user to open new Excel file.
I am unable to do the appending part. Below is the code I tried:
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
The code fills the whole range on each update. I know where my mistake is, but can't figure out proper way. How to make it insert only once until row 49?
Using Excel Object model is not an option as I want to be able to make updates when workbook is open in Excel.

Answer 1

Simple way to achieve this would be to declare your lastRow as more visible (e.g. as private member of your form class), drop looping, and increment lastRow only once per update:
Private lastRow As Integer
'...
objConn.Execute _
"UPDATE [Sheet1$C" & lastRow & ":C" & lastRow _
& "] SET F1 =" & txt1.Text & ";"
lastRow = lastRow + 1
If you assume no complete control over the target Excel range (e.g. data in the range may be modified between your updates, and you do not wish to overwrite those changes) then you could search for the first empty cell before every update. Use IsNull() to test for empty cells.
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
With this in mind, your update routine could be coded as this:
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
Call it from your event handler this way:
Private Sub cmdUpdate_Click()
ExportTextToExcelRow txt1.Text
End Sub