Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Posted in wrong forum - Excel link dump into Access table

Status
Not open for further replies.

mastro78

Programmer
Apr 10, 2007
70
US
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.
 
In your example you are linking to the table name Details$. Regardless of the sheet name that should be the table name, so a query should work. Although I am not sure if it will delete an existing link so you may run into trouble there.
 
Yes, but it's linking to all worksheets in the directory specified, which is what I want to happen. So Details$ comes up as Details$, Details$1, Details$2 and so on. Therefore the name will change so a query would be useless.
 
Why not append to your table and then delete Details$?
 
My code links to all the spreadsheets at one time, if there was a way to loop in a single link, append data, disconnect, then repeat that would be the way to go. But i'm not able to do that with my given knowledge base in VBA.
 
How about this, using the code above, how can I manipulate it so that it:

1) Connects to the first excel file/worksheet
2) Runs an append query
3) Disconnects from that first excel file/worksheet
4) Connects to the second excel file/worksheet
5) Runs the same append query
and so on.

And what determines if it connects to any given excel file/worksheet is if the datemodified has been changed and/or the spreadsheet doesn't already exist.
 
Code:
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.DeleteObject acTable, "Detail$" 'May need error
                                     'handling to continue
    DoCmd.TransferSpreadsheet acLink,_
          acSpreadsheetTypeExcel9, "Details$",_ 
          PathToExcelFiles & ExcelFileName, True
    DoCmd.SetWarnings false
    DoCmd.OpenQuery "qry Append Detail$ to tblDetails"
    DoCmd.SetWarnings True
    End If    
ExcelFileName = Dir
Loop
End Function

This is basically 1-5 except that I delete the link before trying to create it. You may need to trap the error for the table not existing and resume next on it. I did not do any testing so I do not know what error might be generated.

And what determines if it connects to any given excel file/worksheet is if the datemodified has been changed and/or the spreadsheet doesn't already exist.

Sounds like there is at least 2 questions in there but I am not sure what you are asking. Please clarify.
 
All I had to do was put that Delete Object line before the End If and it worked perfectly. Thank you for your help!
 
To clarify the final piece:

Spreadsheets is an Access table that stores the file names and date modified of any given Excel spreadsheet in my current directory. Fields are Spreadsheet and DateModified.

What I would like is that for the code to run the append query for any given worksheet/link but it first looks to see if the file it is linking to has a datelastmodified that is different than the one stored in the Spreadsheets table. If it is different, then it basically copies over the current record with all the information. If it isn't different, then it doesn't link to it and moves to the next file in the list and repeats the process.
 
Function ImportFromExcel()
Dim fs, f, s
Dim ExcelFileName As String
Dim PathToExcelFiles As String

Dim rst As ADODB.Recordset
Dim cnXcell As ADODB.Connection
Dim rsXcell As ADODB.Recordset
Dim WorksheetName As String
Set cnXcell = New ADODB.Connection

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

cnXcell.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "c:\PayrollRec.xls" & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Set rsXcell = cnXcell.OpenSchema(adSchemaTables)
Do While Not rsXcell.EOF
WorksheetName = rsXcell.Fields("TABLE_NAME")
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, WorksheetName , PathToExcelFiles & ExcelFileName, True
rsXcell.MoveNext
Loop


End If
ExcelFileName = Dir
Loop
End Function
 
Not exactly sure what this piece is doing:

cnXcell.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "c:\PayrollRec.xls" & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Set rsXcell = cnXcell.OpenSchema(adSchemaTables)
Do While Not rsXcell.EOF
WorksheetName = rsXcell.Fields("TABLE_NAME")
 
Actually what does this stand for:: OpenSchema(adSchemaTables)
 
Asumming you have tblSheets and it contains 2 files SheetPathName and ModDate:

Code:
Function ImportFromExcel()
Dim fs, f
Dim s as Date
Dim ExcelFileName As String
Dim PathToExcelFiles As String
Dim rsSheet as DAO.Recordset
Set fs = CreateObject("Scripting.FileSystemObject")
PathToExcelFiles = MyLocation
ExcelFileName = Dir(PathToExcelFiles, vbDirectory)
Set rsSheet = Currentdb.openrecordset ("tblSheets")
Do While ExcelFileName <> ""
    If ExcelFileName <> "." And Right(ExcelFileName, 3) = "XLS" Then
    Set f = fs.GetFile(PathToExcelFiles + ExcelFileName)
    s = f.DateLastModified
    rsSheet.FindFirst "SheetPathName = """  &PathToExcelFiles + ExcelFileName """"

    If rsSheet.NoMatch Then
         rsSheet!SheetPathName  = PathToExcelFiles + ExcelFileName
         rsSheet!ModDate = s
         rsSheet.Update
    Else
        If rsSheet!ModDate < s Then
          rsSheet.Edit
          rsSheet!ModDate = s
          rsSheet.Update
        Else
           Goto SkipFile
        End if
    End IF
    DoCmd.DeleteObject acTable, "Detail$" 'May need error
                                     'handling to continue
    DoCmd.TransferSpreadsheet acLink,_
          acSpreadsheetTypeExcel9, "Details$",_ 
          PathToExcelFiles & ExcelFileName, True
    DoCmd.SetWarnings false
    DoCmd.OpenQuery "qry Append Detail$ to tblDetails"
    DoCmd.SetWarnings True
    End If    
SkipFile:
ExcelFileName = Dir
Loop
End Function


Something like above should work. Typically I would avoid the goto but I didn't have to time to do more.

Just be sure you include a DAO reference.
 
DAO is faster than ADO for JET (Access) databases and I can usually write it cold (because of the performance I rarely write ADO code).

You may have to add a reference to the DAO library.

To add the reference: In a module from the tools menu select references. In the dialog find Microsoft DAO 3.6 Obeject Library and check it.

In regards to files, you have two choices store only the file and not the path or store the path and file name. In the latter case you MAY need to add criteria to the findfirst. Let me know if you need more help with that.
 
I already have the reference piece set up, did that when I started the project. And I currently am storing the path in one database initially and in the Spreadsheets table I'm storing the file name only.

I may have an error in the process/order of doing this.
 
What and where is the error? It just sounded like it was a reference error on the surface.

Having your database in a sepearate folder is probably a good idea but not entirely necessary.

Both saving the file and path or just the path may be valid. If by definition the program only deals with a specific path, file names are definitely fine.
 
Actually to avoid having to touch anything in the Spreadsheets table on import, I added the Spreadsheet field to my main data table plus added a function to Excel to capture the filename so when I append it stores it in the access data table. With the onopen of my main form is where I have it checking for datemodified and delete the record accordingly (which in turn deletes it form my main data table). The only piece I have missing is how to avoid linking if the date modified of the excel file is the same as what is stored in the spreadsheets table. Thank you so much for all your help on this. Definitely has allowed me to finish a major piece of this project.
 
What is the code on the On open event of your form?

I am missing a few pieces of information and I think that will clear it up and make it easier to just fix it too.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top