检查值的重复项,Excel VBA是否可以访问?

时间:2017-12-20 23:25:06

标签: vba excel-vba ms-access-2016 excel

我正在尝试从Excel工作表向.accdb添加信息,但是首先需要比较一个值以确定它在表中是否已经存在,如果是,请跳过它并继续下一个行。当我不尝试验证它不存在时,代码的添加信息部分有效,但我无法进行比较。感谢任何帮助,谢谢!

Sub UploadData()

Dim con As Object, cmd As Object, rst As Object
Dim Path As String
Dim WS As Worksheet
Dim L As Range
Dim LT As Long, LC As Long, R As Long
Dim D1 As Date, D2 As Date

Dim PRODL As Integer, TNAME As Integer, CName As Integer, VNAME As Integer, ACTNO As Integer, SOURC As Integer, BATID As Integer, BILID As Integer
Dim CONDT As Integer, BILDT As Integer, DUEDT As Integer, BEGDT As Integer, ENDDT As Integer, PRBAL As Integer, CCHRG As Integer, IMGLC As Integer

Dim i As Integer, Lcol As Integer, LRow As Integer
Dim Calc As Double, CL As Double, CW As Double
Dim Z As String

Set con = CreateObject("ADODB.Connection"): Set cmd = CreateObject("ADODB.Command"): Set rst = CreateObject("ADODB.RecordSet"):
Path = Sheets("AuditTool").Range("B2").Value

Set WS = Worksheets("TestBed")
With WS
    Lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

PRODL = 0
TNAME = 0
CName = 0
VNAME = 0
ACTNO = 0
SOURC = 0
BATID = 0
BILID = 0
CONDT = 0
BILDT = 0
DUEDT = 0
BEGDT = 0
ENDDT = 0
PRBAL = 0
CCHRG = 0
IMGLC = 0


For i = 1 To Lcol
    Z = LCase(WS.Cells(1, i).Value)
    If Z = "productline" Then
        PRODL = i
    End If
    If Z = "teamname" Then
        TNAME = i
    End If
    If Z = "clientname" Then
        CName = i
    End If
    If Z = "vendor" Then
        VNAME = i
    End If
    If Z = "accountnumber" Then
        ACTNO = i
    End If
    If Z = "billreceiptmethod" Then
        SOURC = i
    End If
    If Z = "idbatch" Then
        BATID = i
    End If
    If Z = "idbill" Then
        BILID = i
    End If
    If Z = "consolidationcreatedon" Then
        CONDT = i
    End If
    If Z = "billdate" Then
        BILDT = i
    End If
    If Z = "pastduedate" Then
        DUEDT = i
    End If
    If Z = "begindate" Then
        BEGDT = i
    End If
    If Z = "enddate" Then
        ENDDT = i
    End If
    If Z = "previousbalance" Then
        PRBAL = i
    End If
    If Z = "currentcharges" Then
        CCHRG = i
    End If
    If Z = "imagelocation" Then
        IMGLC = i
    End If
Next i    

With WS
    Set L = .Cells(.Rows.Count, "B").End(xlUp)
    LC = L.Row
End With
If LC < 2 Then
    LC = 2
End If
LT = LC - 1 'count bill IDs

con.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Path & ";Persist Security Info=False;"
con.ConnectionTimeout = 0: con.CommandTimeout = 0: con.Open: cmd.CommandTimeout = 0: Set cmd.ActiveConnection = con

R = 2

On Error Resume Next

With WS
    Do While .Cells(R, 2) <> ""

        AdHocID = 0
        rst.Open "SELECT [ID] FROM AdHocReport WHERE (BillID = " & WS.Cells(R, BILID).Value & ")", con, 1, 3
        AdHocID = rst![ID]

        With rst
            If AdHocID = 0 Then
            .AddNew ' create a new record
            .Fields("BillID") = WS.Cells(R, BILID).Value
            .Fields("ProductLine") = WS.Cells(R, PRODL).Value
            .Fields("TxName") = WS.Cells(R, TNAME).Value
            .Fields("CxName") = WS.Cells(R, CName).Value
            .Fields("VxName") = WS.Cells(R, VNAME).Value
            .Fields("AcctNo") = WS.Cells(R, ACTNO).Value
            .Fields("Source") = WS.Cells(R, SOURC).Value
            .Fields("BatchID") = WS.Cells(R, BATID).Value
            .Fields("ConsolidationDate") = WS.Cells(R, CONDT).Value
            .Fields("BillDate") = WS.Cells(R, BILDT).Value
            .Fields("DueDate") = WS.Cells(R, DUEDT).Value
            .Fields("BeginDate") = WS.Cells(R, BEGDT).Value
            .Fields("EndDate") = WS.Cells(R, ENDDT).Value
            .Fields("PreviousBalance") = WS.Cells(R, PRBAL).Value
            .Fields("CCharges") = WS.Cells(R, CCHRG).Value
            .Fields("ImgLoc") = WS.Cells(R, IMGLC).Value
            '    .Fields("SumAcctNo") = WS.Cells(2, SUMAC).Value
            .Update
            R = R + 1
            Else
            R = R + 1
            End If
        End With
    Loop
End With

MsgBox LT & " Bill IDs Successfully Uploaded"

rst.Close
con.Close

WS.UsedRange.ClearContents

End Sub

我不确定我是否按照正确的顺序进行检查。它的编写方式,它会检测第一个副本并跳过插入,但AdHocID值永远不会改变。请让我知道你的想法。

0 个答案:

没有答案