Excel / Access Question

[MrAustin]

Hello everyone --

My boss has a project for me, and while they seem to get the impression that I know everything about access and excel, this is simply not the case. So major brownie points for me if I can get this working.

I have an access system setup right now to handle vendor disputes for our company (i.e. trouble tickets type thing). My boss wants me to design an excel "upload" form that will upload new disputes information into the access database. That's fine, I've been able to do that with the following code:

Private Sub cmdUploadToAccess_Click()

'--- The purpose of this button is to upload all of these invoices into
'--- MS Access for dispute.  The invoices are uploaded with a default printed
'--- value of "No" so that they may be printed as a batch.

Dim tCount As Integer, cCount As Integer
tCount = Cells(2, "G").Value

Dim tRows As Integer 'The number of rows that hold data
Dim eRow As Integer 'The row that ends the data (VAR)
Dim sRow As Integer 'The row that begins the data (CONST 3)
    sRow = 5
    
'The following constants are used for all uploads
Dim svNum As Long, stNum As Long, dtReq As Date, venName As String, venNum As Double
Dim conName As Integer, conPhone As String, conFax As String, amount As Currency, storeNum As Integer
Dim invType As String, invTypeInfo As Integer, status As Integer, blPrinted As String
Dim strPrintFor As String

strPrintFor = "hhmca0"
dtReq = FormatDateTime(Date, vbShortDate)
venName = "XXX"
venNum = XXX
conName = XXX
conPhone = "(XXX) XXX-XXXX"
conFax = "(XXX) XXX-XXXX"
status = 1
blPrinted = "No"

'Database connection variables
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long, strSQL As String
'Connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
    "Data Source=X:\Tracking.mdb;"
'Open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "tblDisputes", cn, adOpenKeyset, adLockOptimistic, adCmdTable

'Find the number of rows that contain data, subtracting the 3 header rows
eRow = Cells(Rows.Count, "C").End(xlUp).Row
tRows = (Cells(Rows.Count, "C").End(xlUp).Row) - 4

'Cycle through each row of data, uploading its information to the database

For x = sRow To eRow
    With rs
        .AddNew 'Create a new record
        
        'Add values to each field in the record
        .Fields("disp_printFor") = strPrintFor
        .Fields("disp_svNum") = Cells(x, "B").Value
        .Fields("disp_stNum") = Cells(x, "C").Value
        .Fields("disp_DocNum") = Cells(x, "C").Value
        .Fields("disp_dateRequested") = dtReq
        .Fields("disp_vendorName") = venName
        .Fields("disp_vendorNumber") = venNum
        .Fields("disp_contactName") = conName
        .Fields("disp_contactPhone") = conPhone
        .Fields("disp_contactFax") = conFax
        .Fields("disp_storeNum") = Cells(x, "A").Value
        .Fields("disp_amount") = Cells(x, "D").Value
        If IsEmpty(Cells(x, "F")) Then
            .Fields("disp_type") = "Credit Rebill"
        Else
            .Fields("disp_type") = Cells(x, "F").Value
        End If
        .Fields("disp_typeInfo") = Cells(x, "B").Value
        .Fields("disp_status") = 1
        .Fields("disp_printed") = blPrinted
        If Cells(x, "G").Value <> "" Then
            .Fields("disp_comments") = Cells(x, "G").Value
        End If
        If Cells(x, "E").Value <> "" Then
            .Fields("disp_invDate") = Cells(x, "E").Value
        End If
            
        
        'Add more fields if necessary...
        .Update 'Stores the new record
    End With
    cCount = cCount + 1
    tCount = tCount + 1
    Cells(2, "G").Value = tCount
Next x

MsgBox "Upload of " & cCount & " vendor disputes was successful.", vbInformation, "Snoochy Bootchies"
Cells(3, "G").Value = cCount

End Sub

What she wants me to be able to do is highlight any rows, as it is going, that cannot be uploaded for whatever reason. The disp_DocNum field is declared as unique (no duplicates), so if a duplicate is listed on the excel upload sheet, it errors out and stops the upload. What I would like is for it to color that whole row red, then continue with all other disputes.

Is this possible? I know this probably would've been easier done another way, but that's not my say. Thanks you all!

PS: I know the code is probably sloppy, but I'm still new to this and I am trying to learn as quickly as possible.

 

[doulostheou]

You would have to test for the duplicate before trying to add the record to do this. You could change it so that when you open your recordset, you put a WHERE clause that looks for the disp_DocNum. If it returns one, highlight the cells and move on. If it does not find any matches, add the new record.

I used to know the code to highlight a row but cannot think of it right off. If you haven't discovered it already, the Excel macro recorder makes discovering syntax easy. It will show you the code and then you can manipulate it from there.

 

[MrAustin]

Thanks for the quick reply! I'm new to the With RS syntax ... how do you go about adding a WHERE clause? Is there a way to just write out a SQL statement and run that statement from excel? Maybe some pseudo-code to get my brain juicing? Thanks again!

 

[doulostheou]

A trick when you are first learning how to write SQL statements is to design a query that does what you want using Access' built in designer and then peek at the SQL (this is one of the views available to you when you have the query open).

To open your recordset, you would use this line:

rs.Open "SELECT * FROM tblDisputes WHERE disp_DocNum=" & Cells(x, "C").Value, cn

If no record is found the .BOF and .EOF properties will both be set to true. To determine if the record does not exist, you would put the following in your with statement:

If .EOF=True Then
    'Add your record
EndIf

Note that you will need to move the section where you open and close your recordset inside your loop. Actually glancing back over your code, it does not look like you close or release your recordset or connection. This frees up resources and you should start adding it to your code as a course of habit.

with rs
     For x = sRow To eRow
          .Open "SELECT * FROM tblDisputes WHERE disp_DocNum=" & Cells(x, "C").Value, cn
          if .eof=true then
               .addnew
               'Fill in fields
               .update
          else
               'Turn row whatever color you want to
          end if
          .close 'Close recordset
     Next x
end with

set rs = nothing 'Release recordset from memory
cn.close 'Close connection
set cn = nothing 'Release connection from memory