[VBisGreen]

Ok I have a click command that will loop through a specified folder with excel files in it, the loop captures data in specific cells and adds the data to specified fields in an access database. I have no trouble with that, but what I am trying to do is when new files are added to the folder that I can run my loop and it will only find the new files that I specify through an input box or something of a date or date range that I want to update the access database with. Also if it finds duplicate information that it skips the file and moves to the next. Currently if I run the loop again it will just create duplicates in the database. Is there a way to do this?

Dim strPath As String
Dim appExcel As Object
Dim strFolderPath As String
Dim strSQL As String
Dim MyDB As Database
Dim MyRS As Recordset
Dim evaldate As String

Set MyDB = OpenDatabase("\...\mydb.mdb")
Set MyRS = MyDB.OpenRecordset("Test", dbOpenDynaset)


 
strFolderPath = "...\All"
strPath = "...\*.xls"	 'Set the path.
 
strPath = Dir(strPath, vbNormal)

Set appExcel = CreateObject("Excel.Application")

appExcel.Visible = False
appExcel.DisplayAlerts = False

'evaldate = InputBox("What date(s) do you want to update from?", "Select Date", vbOKCancel)


Do While strPath <> ""
  appExcel.Workbooks.Open strFolderPath & strPath
  appExcel.Sheets("Worksheets").Select

  Dim Perf() As String
  ReDim Pref(50)
  Dim Pos() As String
  ReDim Pos(50)
  Dim i As Integer

  Dim PerfT() As String
  ReDim PrefT(7)
  Dim PosT() As String
  ReDim PosT(7)
  Dim w As Integer


  For i = 23 To 50
		Pref(i - 23) = appExcel.Range("H" & i).Value
		Pos(i - 23) = appExcel.Range("L" & i).Value
  Next

	For w = 1 To 7
		PrefT(w - 1) = appExcel.Range("N" & w).Value
		PosT(w - 1) = appExcel.Range("O" & w).Value
  Next

	With MyRS
	  .AddNew
		!WE = appExcel.Range("D14").Text
		!Month = appExcel.Range("D15").Text
		!Name = appExcel.Range("D1").Text
		!ID = appExcel.Range("D2").Text
		!Date = appExcel.Range("D6").Text
		!SVCTG = appExcel.Range("D9").Text
		!Q1 = Pref(0)
		!A1 = Pos(0)
		!Q2 = Pref(1)
		!A2 = Pos(1)
		
	  .Update
	  appExcel.Workbooks.Close
	End With
strPath = Dir


Loop
 
appExcel.Quit
Set appExcel = Nothing
 
MyRS.Close
Set MyRS = Nothing
 
MsgBox "Completed!"
Unload Me
End Function