Excel VBA在现有值下添加logging
我一直在开发一个小工具,查询我们的数据库并返回一些引用。
我有一个问题,在Excel Sheet1
中已经存在的值下面添加新查询的值。
Option Explicit Public Ref As String Const DWConnectString = "Provider=SQLOLEDB... " Public Property Get rRef() As String rRef = Me.TextBox1.Value Ref = Trim(rRef) End Property Private Sub TextBox1_Change() Dim rRef As String rRef = Me.TextBox1.Value End Sub Private Sub ZoekRef_Click() Dim cn As Object Dim rs As Object Dim cm As Object Dim Ref As String Dim StrSource As String Dim startrow As Integer Ref = rRef Set cn = CreateObject("ADODB.Connection") cn.Open DWConnectString Set rs = CreateObject("ADODB.Recordset") 'rs = New ADODB.Recordset StrSource = "Select CONSIGNMENT.CONSIGNMENT, CONSIGNMENT.DOCUMENT_REMARK_2, INVOICE_HIST.NET_AMOUNT, INVOICE_HIST.VAT_AMOUNT, INVOICE_HIST.INV_CURRENCY " StrSource = StrSource & "from CONSIGNMENT left outer join INVOICE_HIST ON CONSIGNMENT.CONSIGNMENT=INVOICE_HIST.CONSIGNMENT " StrSource = StrSource & "where DOCUMENT_REMARK_2 like '%" StrSource = StrSource & Ref & "%'" rs.Open StrSource, cn If rs.EOF Then MsgBox "Geen Resultaten" Exit Sub Else Dim fieldNames, j rs.MoveFirst ReDim fieldNames(rs.Fields.Count - 1) For j = 0 To rs.Fields.Count - 1 fieldNames(j) = rs.Fields(j).Name Next Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, rs.Fields.Count)).Value = fieldNames For j = 1 To rs.Fields.Count Sheet1.Columns(j).AutoFit Next Sheet1.Cells.CopyFromRecordset rs 'fldcount2 = Sheets("sheet1").UsedRange.Rows.Count Sheet1.Rows(1).Insert Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, rs.Fields.Count)).Value = fieldNames startrow = 3 Do Until rs.EOF rs.MoveNext startrow = startrow + 1 Loop End If rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub
我想过使用该行:
Do until trim(cells(startrow,1).Value) = "" startrow = startrow + 1 Loop
之前的rs.Movenext
行,但似乎testinglogging集,而不是实际的Excel文件。
在添加新logging集之前,我可以testing当前Sheet1的值吗?
谢谢您的帮助。
扩大循环的范围。
rs.MoveFirst Do Until rs.EOF 'Do all your work here 'Then increment your counter and the recordset rs.MoveNext startrow = startrow + 1 Loop