Question

我一直在开发一个查询数据库并返回一些引用的小工具。

我在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行之前，但似乎测试记录集，而不是实际的excel文件。

我可以在添加新记录集之前测试当前Sheet1的值，使其低于已存在的值吗？

感谢您的帮助。

Answer 1

扩大循环范围。

rs.MoveFirst
Do Until rs.EOF

   'Do all your work here


   'Then increment your counter and the recordset
    rs.MoveNext
    startrow = startrow + 1
Loop

Excel VBA在现有值下添加记录

1 个答案: