Help with importing

  • Thread starter Thread starter jln via AccessMonster.com
  • Start date Start date
J

jln via AccessMonster.com

I need to find a way to import a large amount of excel workbooks in to a
single table all of the work books are made up of one worksheet. The names
change each month. What i was thinking was to have a file open box pop up
that would allow me to select the location of the files.

Im not sure on how to go about this since when importing a file you can only
chose one at a time.
 
First, you will want to download the code at this site and review the
instructions on how to use it:
http://www.mvps.org/access/api/api0002.htm

Then once you have the folder, you can use the Dir function to loop through
all the .xls files in the folder and import them into your table. Once issue
you need to be aware of is that each time you do a TransferSpreadsheet, it
will replace the records in your table. The way to handle this is to link to
the spreadsheet file, use an append query to add the data to the Access
table, and delete the spreadsheet table when you are done. So using the code
and example from above, it would be something like this:

strFolderName = BrowseFolder("What Folder you want to select?")

strFileName = Dir(strFolderName & "\*.xls")
Do while Len(strFileName) > 0
Docmd.TransferSpreadsheet acLink, , "ImportData", strFileName, True
CurrentDb.Execute("qappAddToTable"), dbFailOnError
Docmd.DeleteObject acTable, "ImportData"
Loop

qappAddToTable is a made up name. Just create an Append query to append
data from the spreadsheet to the table and use whatever the name of that
query is in that line.
 
Im alittle lost on this I looked at the code but im not usre how to use that
along with what you posted. Could you help me?
OK here is the code from the page I get that i place it in a new module but
how do i call it and add in what you sent posted? 2nd What ios the best way
to call it, Could I place it under a click functionfor a button?

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function
 
The code you downloaded goes in a standard module. It doesn't matter what yo
name it as long as it is not the same name as any function or sub in the
module. Mine is named modBrowseFolders.

To allow the user to select the folder, you call the BrowseFolder function.
It has only one argument which is a string that will put a message at the top
of the dialog. This will give you the starting directory. Then you use the
Dir function to begin retrieving file names and importing them into your
table. You can use standard wild cards to limit the names and types of files
that will be returned.

What you have to be aware of is that the TransferSpreadsheet method will
overwrite the data in an existing table. Since you want to import multiple
worksheets into one table, you will need to allow for that. I suggest rather
than an import, you link the spreadsheets as a table and transfer the data. I
would recommend you create an Append query that copies records from the
spreadsheet table into your Access table.

The order of events is:
Get a folder to use from the user.
Retrieve a filename using the Dir function
Link to the file
Run the Append query to copy in the data
Use the DeleteObject method the destroy the link
Repeat until all matching files have been imported.

Dim StrFolder As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb
strFolder = BrowseFolder("Select Folder For Imports")
If Len(strFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If

strFullName = Dir(strFolder & conFilter)
Do While Len(strFullName) <> 0
dbf.Execute("DELETE * FROM tblXlImport;"), dbFailOnError
DoCmd.TransferSpreadsheet, acLink, , "tblXlImport", strFullName, True
dbf.Execute("qappXlImport"), dbFailOnError
DoCmd.DeleteObject acTable, "tblXlImport"
Dir()
Loop

dbf.Execute("DELETE * FROM tblXlImport;"), dbFailOnError
Set dbf = Nothing
 
I just realized there is an error in the code I posted. Sorry, but the way
it was originally written, it would delete all the data currently in your
table, then delete all the data you just imported. Here is the corrected
version:

Note that tblXlImport is the name of the table you want to import the data
into. Just change that to whatever your table name actually is.

Dim StrFolder As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb
strFolder = BrowseFolder("Select Folder For Imports")
If Len(strFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If

strFullName = Dir(strFolder & conFilter)
Do While Len(strFullName) <> 0
DoCmd.TransferSpreadsheet, acLink, , "tblXlImport", strFullName, True
dbf.Execute("qappXlImport"), dbFailOnError
DoCmd.DeleteObject acTable, "tblXlImport"
Dir()
Loop

Set dbf = Nothing
 
OK im starting to follow. I was thinking of hard coding the foldername since
that will never change. What would that change?
The code you downloaded goes in a standard module. It doesn't matter what yo
name it as long as it is not the same name as any function or sub in the
module. Mine is named modBrowseFolders.

To allow the user to select the folder, you call the BrowseFolder function.
It has only one argument which is a string that will put a message at the top
of the dialog. This will give you the starting directory. Then you use the
Dir function to begin retrieving file names and importing them into your
table. You can use standard wild cards to limit the names and types of files
that will be returned.

What you have to be aware of is that the TransferSpreadsheet method will
overwrite the data in an existing table. Since you want to import multiple
worksheets into one table, you will need to allow for that. I suggest rather
than an import, you link the spreadsheets as a table and transfer the data. I
would recommend you create an Append query that copies records from the
spreadsheet table into your Access table.

The order of events is:
Get a folder to use from the user.
Retrieve a filename using the Dir function
Link to the file
Run the Append query to copy in the data
Use the DeleteObject method the destroy the link
Repeat until all matching files have been imported.

Dim StrFolder As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb
strFolder = BrowseFolder("Select Folder For Imports")
If Len(strFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If

strFullName = Dir(strFolder & conFilter)
Do While Len(strFullName) <> 0
dbf.Execute("DELETE * FROM tblXlImport;"), dbFailOnError
DoCmd.TransferSpreadsheet, acLink, , "tblXlImport", strFullName, True
dbf.Execute("qappXlImport"), dbFailOnError
DoCmd.DeleteObject acTable, "tblXlImport"
Dir()
Loop

dbf.Execute("DELETE * FROM tblXlImport;"), dbFailOnError
Set dbf = Nothing
Im alittle lost on this I looked at the code but im not usre how to use that
along with what you posted. Could you help me?
Click to expand...
[quoted text clipped - 43 lines]
End If
End Function
Click to expand...
Click to expand...
 
Ok i think i have the code Right now. WHats the best way to call this? Also
Im lost on the query shoukld i have it just query all the data I need?

Public Sub Import_PayoffMismatch()

Dim StrFolder As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb
StrFolder = ("S:\Iashare\0Subprime\Payoffmissmatch")
If Len(StrFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If

strFullName = Dir(StrFolder & conFilter)
Do While Len(strFullName) <> 0
DoCmd.TransferSpreadsheet , acLink, , "PayoffMisMatch", strFullName,
True
dbf.Execute ("qappXlImport"), dbFailOnError
DoCmd.DeleteObject acTable, "PayoffMisMatch"

Loop

Set dbf = Nothing

End Sub
 
To run it, ut a command button on a form. Put the code in the Click Event of
the button.

First, manually link to one of your spreadsheets. Then open the query
builder and select the linked table. The make it an Append Query. Give it
the name of your table in the Append To. Make sure your fields match up like
you want them.

Save the query, delete the link to the spreadsheet.

In your previous post, you said the folder would always be the same. In
that case, you don't need the call to the BrowseFolder, but if I were you, I
would leave it in. You never know when things may change.
 
Klatuu Does this look right im getting an error Typ mismatch

Private Sub Command0_Click()

Dim StrFolder As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb
StrFolder = ("S:\Iashare\0Subprime\Payoffmissmatch")
If Len(StrFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If

strFullName = Dir(StrFolder & conFilter)
Do While Len(strFullName) <> 0
DoCmd.TransferSpreadsheet , acLink, , "PayoffMisMatch", strFullName,
True (HERE)
dbf.Execute ("qry_PayoffMismatch"), dbFailOnError
DoCmd.DeleteObject acTable, "PayoffMisMatch"

Loop

Set dbf = Nothing

End Sub

To run it, ut a command button on a form. Put the code in the Click Event of
the button.

First, manually link to one of your spreadsheets. Then open the query
builder and select the linked table. The make it an Append Query. Give it
the name of your table in the Append To. Make sure your fields match up like
you want them.

Save the query, delete the link to the spreadsheet.

In your previous post, you said the folder would always be the same. In
that case, you don't need the call to the BrowseFolder, but if I were you, I
would leave it in. You never know when things may change.
Ok i think i have the code Right now. WHats the best way to call this? Also
Im lost on the query shoukld i have it just query all the data I need?
Click to expand...
[quoted text clipped - 25 lines]
End Sub
Click to expand...
Click to expand...
 
I don't see the problem. Here is what I would do.
Open the form in design mode.
Get into the VBA code.
Put your cursor on the line that is having the problem
Press F9 - This will create a breakpoint and the code will stop before
executing this line.
When the code breaks, look to see what the value in strFullName is. It
should be the path and name of an .xls file in the folder.

jln via AccessMonster.com said:
Klatuu Does this look right im getting an error Typ mismatch

Private Sub Command0_Click()

Dim StrFolder As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb
StrFolder = ("S:\Iashare\0Subprime\Payoffmissmatch")
If Len(StrFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If

strFullName = Dir(StrFolder & conFilter)
Do While Len(strFullName) <> 0
DoCmd.TransferSpreadsheet , acLink, , "PayoffMisMatch", strFullName,
True (HERE)
dbf.Execute ("qry_PayoffMismatch"), dbFailOnError
DoCmd.DeleteObject acTable, "PayoffMisMatch"

Loop

Set dbf = Nothing

End Sub

To run it, ut a command button on a form. Put the code in the Click Event of
the button.

First, manually link to one of your spreadsheets. Then open the query
builder and select the linked table. The make it an Append Query. Give it
the name of your table in the Append To. Make sure your fields match up like
you want them.

Save the query, delete the link to the spreadsheet.

In your previous post, you said the folder would always be the same. In
that case, you don't need the call to the BrowseFolder, but if I were you, I
would leave it in. You never know when things may change.
Ok i think i have the code Right now. WHats the best way to call this? Also
Im lost on the query shoukld i have it just query all the data I need?
Click to expand...
[quoted text clipped - 25 lines]
End Sub
Click to expand...
Click to expand...
Click to expand...
 
OK i changed a few things in the code Im get ting a expression that you
entered is the wrong data type for one of the arguments.

Private Sub Command0_Click()

Dim StrFolder As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb
StrFolder = ("S:\Iashare\0Subprime\Payoffmissmatch")
If Len(StrFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If

strFullName = ("S:\Iashare\0Subprime\Payoffmissmatch\*.xls")
Do While Len(strFullName) <> 0
DoCmd.TransferSpreadsheet , acImport, , "PayoffMisMatch", strFullName,
True
dbf.Execute ("qry_PayoffMismatch"), dbFailOnError
DoCmd.DeleteObject acTable, "PayoffMisMatch"

Loop

Set dbf = Nothing

End Sub

I don't see the problem. Here is what I would do.
Open the form in design mode.
Get into the VBA code.
Put your cursor on the line that is having the problem
Press F9 - This will create a breakpoint and the code will stop before
executing this line.
When the code breaks, look to see what the value in strFullName is. It
should be the path and name of an .xls file in the folder.
Klatuu Does this look right im getting an error Typ mismatch
Click to expand...
[quoted text clipped - 44 lines]
Click to expand...
 
Ok i went back to the start and here is what i have.
1st Problem Dir() is wrong


Option Compare Database

Private Sub Command0_Click()
Dim StrFolder As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb
StrFolder = BrowseFolder("Select Folder For Imports")
If Len(StrFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If

strFullName = Dir(StrFolder & conFilter)
Do While Len(strFullName) <> 0
DoCmd.TransferSpreadsheet , acLink, , "PayoffMisMatch", strFullName,
True
dbf.Execute ("qry_PayoffMismatch"), dbFailOnError
DoCmd.DeleteObject acTable, "PayoffMisMatch"
Dir()
Loop


Set dbf = Nothing

End Sub
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function
 
Well, it is not dir that is wrong, the problem is I forgot that browsefolder
does not return the path, it only returns a file name. My apologies. Try
this:

Private Sub Command0_Click()
Dim StrFolder As String
Dim strFileName As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb
StrFolder = BrowseFolder("Select Folder For Imports")
If Len(StrFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If

strFileName = Dir(StrFolder & conFilter)
Do While Len(strFullName) <> 0
strFullName = strFolder & "\" & strFilename
DoCmd.TransferSpreadsheet , acLink, , "PayoffMisMatch", strFullName,
True
dbf.Execute ("qry_PayoffMismatch"), dbFailOnError
DoCmd.DeleteObject acTable, "PayoffMisMatch"
Dir()
Loop


Set dbf = Nothing
 
I dont know if im Missing something or just that bone headed. Can some one
take a look Im getting problems on the syntax of a few lines. If someone
could put this in a compiler and take alook at the code I tried to mark all
the lines that are causing problems but i know i missed a few. The problems
seem to be all syntax related. I know if someone ran though it looking at
just the syntax that might be all that i need.
Private Sub Command0_Click()
Dim StrFolder As String
Dim strFileName As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb
StrFolder = BrowseFolder("Select Folder For Imports")
If Len(StrFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If
Click to expand...
strFileName = Dir(StrFolder & conFilter)
Do While Len(strFullName) <> 0
strFullName = strFolder & "\" & strFilename
DoCmd.TransferSpreadsheet , acLink, , "PayoffMisMatch", strFullName,
True
dbf.Execute ("qry_PayoffMismatch"), dbFailOnError
DoCmd.DeleteObject acTable, "PayoffMisMatch"
Dir() ' PROBLEM HERE
Loop
Click to expand...
Set dbf = Nothing
ENd Sub
' MY PROBLEM ARE BELOW HERE
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

' PROBLEM HERE
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _

"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

' PROBLEM HERE
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _

"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function
 
Dir() ' PROBLEM HERE
Should be
strFileName = Dir()

The other problems with the browse folder code may be where you have it.
You should put the code as it is on the web site in a standard module by
itself. Do not name the module any name in the code. my suggestion in you
name it something like modBrowseFolders. Using the mod prefix will prevent
any naming ambiguities.
 
OK sorry to keep doing this. Is this right

Option Compare Database

Private Sub Command0_Click()
strFileName = Dir()
Private Sub Command0_Click()
Dim StrFolder As String
Dim strFileName As String
Dim strFullName As String
Dim dbf As Database
Const conFilter As String = "\*.xls"

Set dbf = CurrentDb

StrFolder = modBrowseFolders("Select Folder For Imports")
' CALLING HERE I GET AN ERROR SAYING EXPECTED VARIABLE OR PROCEDURE, NOT
MODULE

If Len(StrFolder) = 0 Then
MsgBox "Import Canceled"
Exit Sub
End If

strFileName = Dir(StrFolder & conFilter)
Do While Len(strFullName) <> 0
strFullName = StrFolder & "\" & strFileName
DoCmd.TransferSpreadsheet , acLink, , "PayoffMisMatch", strFullName,
True
dbf.Execute ("qry_PayoffMismatch"), dbFailOnError
DoCmd.DeleteObject acTable, "PayoffMisMatch"
strFileName = Dir()
Loop


Set dbf = Nothing

End Sub
 
You do not call the name of a module. A module can contain more than one
function and/or sub. You call the name of the fuction or sub your want to
execute.

The name of the function in modBrowseFolders is BrowseFolder. It accepts
one argument, the title you want on the dialog box.
StrFolder = modBrowseFolders("Select Folder For Imports")
Click to expand...
Should be
StrFolder = BrowseFolder("Select Folder For Imports")
 
Ok fixed that problem. Hopefully last question I sent a break point on Do
While Len(strFullName) <> 0 I checked the value of Len and it was 0 everytime.
I have 2 files in the folder but its not picking them up. As soon as it see
Len = 0 it jumps to Set dfb = Nothing which would be right if there was no
files to import. It never reaches DoCmd.TransferSpreadsheet , acLink, ,
"PayoffMisMatch", strFullName, True because of Len = 0.
 
Sorry for all the syntax errors. This one was when we made a change earlier,
I missed this one.
Do While Len(strFullName) <> 0
Should be
Do While Len(strFileName) <> 0

strFullName has not been populated yet. We are just looking for a return
from the Dir function to see if there are more files to process.
 
I don't know if I already posted this. Something wierd happend.

Do While Len(strFullName) <> 0
should be
Do While Len(strFileName) <> 0

Sorry I missed that when we made some changes earlier.
 
Back
Top