Posted in wrong forum - Excel link dump into Access table

[mastro78]

Here is the code that creates the links (I call it in the OnOpen event of my switchboard):

Function ImportFromExcel()
Dim fs, f, s
Dim ExcelFileName As String
Dim PathToExcelFiles As String
Set fs = CreateObject("Scripting.FileSystemObject")
PathToExcelFiles = MyLocation
ExcelFileName = Dir(PathToExcelFiles, vbDirectory)
Do While ExcelFileName <> ""
If ExcelFileName <> "." And Right(ExcelFileName, 3) = "XLS" Then
Set f = fs.GetFile(PathToExcelFiles + ExcelFileName)
s = f.DateLastModified
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, "Details$", PathToExcelFiles & ExcelFileName, True
End If
ExcelFileName = Dir
Loop
End Function

Now I need a way for all the linked data to be dumped into an Access table after the link has been established. The Access table will have all the same field names/types. It's called tblDetails. Any ideas? Note: the linked worksheets will never have the same name so using a query doesn't seem feasible, but I might be wrong. I appreciate any help you can give in this matter.

 

[mastro78]

ONOPEN EVENT AND BUTTON CLICK:
Private Sub Active_Click()
Call ImportFromExcel
DoCmd.OpenForm "frmDetails"
End Sub
Private Sub Form_Open(Cancel As Integer)
'Set menu title
Dim dbs As Database, cnt As Container
Dim doc As Document, prp As Property, CapStr As String
Set dbs = CurrentDb ' Define Database object.
Set cnt = dbs.Containers!Databases ' Define Container object.
Set doc = cnt.Documents!SummaryInfo ' Define Document object.
CapStr = doc.Properties("Title")
'Prepare the database on opening the form
Dim Posst As DAO.Recordset
Dim savwks As String
Dim mylocal As DAO.Recordset
Set mylocal = CurrentDb.OpenRecordset("tblSetup", dbOpenTable)
Set Posst = CurrentDb.OpenRecordset("Spreadsheets", dbOpenTable)
'Delete contents of Spreadsheets Table
myname = Dir(CurrentDb.Name, vbNormal)
mypath = mylocal.Fields("OpenClaims")
Do Until Posst.EOF
If Posst.Fields("DateModified").Value <> FileDateTime(mypath + myname) Then savwks = Posst.Fields("Spreadsheet")
Posst.Delete
Posst.MoveNext
Loop
'Read new Spreadsheets available via Setup path selected
myname = Dir(CurrentDb.Name, vbNormal)
mypath = mylocal.Fields("OpenClaims")
'BeginTrans
myname = Dir(mypath + "*.XLS")
Do While myname <> "" ' Start the loop.
Posst.AddNew
Posst.Fields("Spreadsheet").Value = myname 'Set the filename
Posst.Fields("DateModified").Value = FileDateTime(mypath + myname) 'Set Date Modified
If myname = savwks Then Posst.Fields("Loaded") = -1
Posst.Update
myname = Dir ' Get next entry.
Loop
'CommitTrans
Posst.MoveLast
XLcnt = Posst.RecordCount
If XLcnt > 0 Then Me.Caption = CapStr & " with " & XLcnt & " spreadsheets"
If XLcnt = 0 Then
MsgBox "No Spreadsheets with data found."
Posst.Close
Quit
End If
'Close the recordset
Posst.Close
End Sub

MODULE IMPORTFROMEXCEL
(not working as it should because with the OnOpen with the main form it assigns the new datemodified, so by the time i call the function the datemodified i'm comparing in the spreadsheet table to the file's date modified will always be the same. need to figure out some sort of order)
Function ImportFromExcel()
Dim fs, f, s
Dim ExcelFileName As String
Dim PathToExcelFiles As String
Dim Posst As DAO.Recordset
Set Posst = CurrentDb.OpenRecordset("Spreadsheets", dbOpenTable)

Set fs = CreateObject("Scripting.FileSystemObject")
PathToExcelFiles = MyLocation
ExcelFileName = Dir(PathToExcelFiles, vbDirectory)
Do While ExcelFileName <> ""
If ExcelFileName <> "." And Right(ExcelFileName, 3) = "XLS" Then
Set f = fs.GetFile(PathToExcelFiles + ExcelFileName)
s = f.DateLastModified
If Posst.Fields("DateModified") = s Then MsgBox "No Modifications" Else
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, "Details$", PathToExcelFiles & ExcelFileName, True
DoCmd.SetWarnings False
DoCmd.OpenQuery "AppDetails"
DoCmd.SetWarnings True
DoCmd.DeleteObject acTable, "Details$" 'Delete's link
End If
ExcelFileName = Dir
Loop
End Function

 

[lameid]

In Function ImportFromExcel instead of
If Posst.Fields("DateModified") = s

Try
If Posst.Fields("DateModified") >= s

Actually, Fields is the default collection so try...
If Posst!DateModified >= s

Also if you look back at my example for this you see I both add and update the record in one procedure. If you do this instead of adding the records in the on open event, it should work cleaner.

Also looking at my code I left out a line...

     If rsSheet.NoMatch Then
          rsSheet.Addnew 'Left this out

 

[mastro78]

Looking at your code, that findfirst line I'm having trouble with. The field in the table Spreadsheets that contains the filename is Spreadsheet and it only contains the filename no path with it. The path is stored in a different table. So when you say "Spreadsheet = """ &PathToExcelFiles + ExcelFileName """" wouldn't that be looking to compare the value in the field Spreadsheet to the value of PathToExcelFiles + ExcelFileName?

 

[mastro78]

And when should I call the Import Function? From the way the function works in your code, looks like I wouldn't need all that I have in the OnOpen event and just call this module instead?

Unfortunately, no matter how I go about it I get the unsupported object error 3251.

 

[lameid]

You can easily change the code to work on file only.

You could call the function on the Form's on open event like you are doing now or call it some other way that makes sense in your environment.

Unfortunately, no matter how I go about it I get the unsupported object error 3251.

Whose code, what line of code and what is the text of the error?

 

[mastro78]

rsSheet.FindFirst "SheetPathName = """ &PathToExcelFiles + ExcelFileName """"

Actually now I get a syntax error for some reason. I was just trying to mimic it.

 

[lameid]

I had mixed operators because I copied your concatenation...

rsSheet.FindFirst "SheetPathName = """ & PathToExcelFiles & ExcelFileName """"

But obviously you want something with just the file name, perhaps:

rsSheet.FindFirst "FileName = """ & ExcelFileName """"

 

[mastro78]

With the four sets of quotes at the end, says unexpected end of statement and highlights those. All the code is identical to what you gave me. What is strange is something changed from unsupported object to this.

 

[lameid]

Not really, I edited quickly and left out a concatenation operator...

rsSheet.FindFirst "FileName = """ & ExcelFileName &

 

[mastro78]

Error 3251

Operation is not supported for this type of object - is the error i get now

 

[lameid]

You do have the declaration as the following?

Dim rsSheet as DAO.Recordset

And it does compile right?

 

[mastro78]

Yes and yes.

 

[lameid]

Is it on the same line of code... I know FindFirst is a method in DAO. I think in ADO it was switched to find.

Unless the problem is with the tablename as in you didn't change it to work with your table and field names?

 

[mastro78]

As far as I can see everything is as it should be. Just seems to be having a problem with that line.

 

[lameid]

In the line above or below that line try typing:

rsheet.

You should get a drop down of methods and properties as soon as you hit the dot/period. See if you can select findfirst from that list or see what type of find is in the list.

Honestly, I am stumped.