0 Replies - 3732 Views - Last Post: 15 April 2008 - 01:20 PM Rate Topic: -----

#1 VBisGreen  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 2
  • Joined: 14-March 08

Looping through folder, update new record in Access database

Post icon  Posted 15 April 2008 - 01:20 PM

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

  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

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

	With MyRS
		!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)
	End With
strPath = Dir

Set appExcel = Nothing
Set MyRS = Nothing
MsgBox "Completed!"
Unload Me
End Function

Is This A Good Question/Topic? 0
  • +

Page 1 of 1