haffy311

Board Regular
Joined
Jan 20, 2011
Messages
83
Hello,

I have VBA code which works perfectly to export the excel data into an access table.

One thing I would like to do is only export the rows where the columns containing the date stamp (column I) = the current date. This would help me from exporting data that.s already recorded in the access table.

Any advice would appreciated - current code is below.

Code:
Private Sub ADOFromExcelToAccess()


Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim r As Long
'as long as the excel file is stored in the same location as the access file, this will find it.
dbpath = Application.ActiveWorkbook.Path & "\JLR CANADA_Concept_Log.accdb"
Set cn = New ADODB.Connection


cn.Open "Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & dbpath & ";"


Set rs = New ADODB.Recordset
'opens the table in access
rs.Open "Concept_Logging", cn, adOpenKeyset, adLockOptimistic, adCmdTable


r = 1
Do While Len(Range("A" & r).Formula) > 0
With rs
.AddNew
'Access table field translation
.Fields("Material Number") = Range("A" & r).Value
.Fields("Width") = Range("B" & r).Value
.Fields("Depth") = Range("C" & r).Value
.Fields("Height") = Range("D" & r).Value
.Fields("WEIGHT") = Range("E" & r).Value
.Fields("PKG QTY") = Range("F" & r).Value
.Fields("Put away Qty") = Range("G" & r).Value
.Fields("WHN") = Range("H" & r).Value
.Fields("Date Stamp") = Range("I" & r).Value
.Fields("Time Stamp") = Range("J" & r).Value
.Fields("USER") = Range("K" & r).Value
.Fields("Option 1") = Range("L" & r).Value
.Fields("Option 2") = Range("M" & r).Value
.Fields("Option 3") = Range("N" & r).Value
.Fields("Option 4") = Range("O" & r).Value
.Fields("Option 5") = Range("P" & r).Value
.Update
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
    
End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

bobsan42

Well-known Member
Joined
Jul 14, 2010
Messages
1,343
try like this:
Code:
Private Sub ADOFromExcelToAccess[COLOR=#ff0000]Today[/COLOR]()


    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim r As Long
    'as long as the excel file is stored in the same location as the access file, this will find it.
    dbpath = Application.ActiveWorkbook.Path & "\JLR CANADA_Concept_Log.accdb"
    Set cn = New ADODB.Connection
    
    cn.Open "Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & dbpath & ";"
    
    Set rs = New ADODB.Recordset
    'opens the table in access
    rs.Open "Concept_Logging", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    
    r = 1
    Do While Len(Range("A" & r).Formula) > 0
[COLOR=#ff0000]        If Range("I" & r).Value = Date Then[/COLOR]
            With rs
                .AddNew
                    'Access table field translation
                    .Fields("Material Number") = Range("A" & r).Value
                    .Fields("Width") = Range("B" & r).Value
                    .Fields("Depth") = Range("C" & r).Value
                    .Fields("Height") = Range("D" & r).Value
                    .Fields("WEIGHT") = Range("E" & r).Value
                    .Fields("PKG QTY") = Range("F" & r).Value
                    .Fields("Put away Qty") = Range("G" & r).Value
                    .Fields("WHN") = Range("H" & r).Value
                    .Fields("Date Stamp") = Range("I" & r).Value
                    .Fields("Time Stamp") = Range("J" & r).Value
                    .Fields("USER") = Range("K" & r).Value
                    .Fields("Option 1") = Range("L" & r).Value
                    .Fields("Option 2") = Range("M" & r).Value
                    .Fields("Option 3") = Range("N" & r).Value
                    .Fields("Option 4") = Range("O" & r).Value
                    .Fields("Option 5") = Range("P" & r).Value
                .Update
            End With
[COLOR=#ff0000]        End If[/COLOR]
        r = r + 1
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub
 

haffy311

Board Regular
Joined
Jan 20, 2011
Messages
83
Thank you. This works perfectly and glad to see it didn't take a lot of extra code.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,445
Messages
5,528,801
Members
409,835
Latest member
Mafu1267

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top