Import from Excell Macro

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am wanting to use a Macro which will be connected to a form button to take
the following actions:

1. open a window box allowing the user to select which folder to import the
excell files from

2.import the excell all excell files that are contained within the folder

I have little to no experience with writing macros for Access and have
struggled with the process. Is this even possible to do? If it is where can I
get the information needed to make this process a reality? If someone has
already writen the code for this process and wants to paste it in a reply so
I need only to transfer it to the module I would be extremely greatful!
 
Do you want to use a macro, or do you want to use VBA code? They are not the
same in ACCESS.
 
Is there a difference? Will it change the way that the import takes place? If
there isn't a big difference then it doesn't really matter to me which I use
as long as the end result is the same?
 
Is there a difference? Oh, yes.

VBA will be easier to set up.

Using a macro will require a "finessing trick" of using a hidden form for
storing info as you go along, or will require using more than one macro (one
macro must loop within another).

So, is VBA ok? If yes, let us know and we can provide sample code.

(By the way, I asked about VBA vs. macro because you posted your question in
a macros newsgroup, so I didn't want to run off with VBA within this context
unless that is what you want to do.)
 
Yes VBA would be great especially if we can avoid headaches with multiple
macros - I posted in the Macro catagory because I didn't know about the VBA
possibility -
 
Are you familiar with VBA? I'm going to post some general suggestions; post
back for more specific answers/suggestions.

See the code at http://www.mvps.org/access/api/api0001.htm for a way to let
the user actually browse to and select the file.

See Dir function in VBA Help for how to get a list of all .xls files within
a folder (using the wildcard * to the left of the .xls in the filename
argument).

See TransferSpreadsheet method (DoCmd.TransferSpreadsheet) in VBA Help for
information on how to import an EXCEL spreadsheet via this method.

You can do the following with the above items:

(1) Get the folder from user using the
http://www.mvps.org/access/api/api0001.htm code.

(2) Get one of the .xls file's filename in the chosen folder using the Dir
function.

(3) Set up a loop based on stopping the loop when the result from the Dir
function is an empty string.

(4) Do the TransferSpreadsheet action within the loop; then recursively call
the Dir function (without any arguments) to get the next filename in the
folder.

(5) Continue the loop until no more files can be imported.
--

Ken Snell
<MS ACCESS MVP>
 
This is what I have so far,

Dim strFilter As String
Dim strInputFileName as string

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
strInputFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=True, _
DialogTitle:="Please select an input file...", _
Flags:=ahtOFN_HIDEREADONLY)

Private Sub Command1_Click()
Dim strDirectory As String
Dim strFileName As String

strDirectory = BrowseFolder("Select A Folder")

strFileName = Dir(strDirectory, vbDirectoyr)

Do While strFileName <> vbNullString
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"SomeTable", _
strDirectory & "\" & strFileName, True
Loop


But I don't know how to to recursively call the dir function without any
arguments. Does everything else look like I'm on the right track?
 
I've added line just before the Loop line to do the additional calls to Dir
function:


Private Sub Command1_Click()
Dim strDirectory As String
Dim strFileName As String

strDirectory = BrowseFolder("Select A Folder")

strFileName = Dir(strDirectory, vbDirectoyr)

Do While strFileName <> vbNullString
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"SomeTable", _
strDirectory & "\" & strFileName, True
strFileName = Dir()
Loop


Be sure that you copied all the code from the mvps.org/access website into a
regular module.
 
I am a little confused I thought it would all go into the same module -

so i created a module called Open Dialog box and entered

Dim strFilter As String
Dim strInputFileName as string

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
strInputFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=True, _
DialogTitle:="Please select an input file...", _
Flags:=ahtOFN_HIDEREADONLY)

this when run opens a box that says "Macro" and has an area to enter a Macro
Name. Is this where I enter the loop code?
 
It appears that you did not put all the code from the mvps.org/access site
into the regular module. Go back to that site and look farther down the
page. You'll see a huge block of code that starts with the line
'***************** Code Start **************

All the code from that line down to this line must be put in a regular
module (except you can leave out the code associated with the function
"TestIt()" that is near the top of that block of code:
'************** Code End *****************


The code that you've posted is just a sample code snippet to show how you
would call the "open/browse" window. Do not use any of this code.

What you need is to put code in the form's module, connected to the button's
Click event, that will then run the API code and do the TransferSpreadsheet
work:


Private Sub Command1_Click()
Dim strDirectory As String, strFilter As String
Dim strFileName As String, strInputFileName As String

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
strInputFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=True, _
DialogTitle:="Please select an input file...", _
Flags:=ahtOFN_HIDEREADONLY)
' I don't know what function the "BrowseFolder" is???
' so I have left it out of this code
strDirectory = Left(strInputFileName, _
InStrRev(strInputFileName, "\")
strFileName = Dir(strDirectory & "*.xls")

Do While strFileName <> vbNullString
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"SomeTable", _
strDirectory & strFileName, True
strFileName = Dir()
Loop

End Sub
 
Sorry for being such a pain with this. I have created the "open Dialog box"
Module in the modules folder. However, it only alows me to search for Access
Databases. Where do i change this so that it allows me to pull excell files?

Also So I understand what your are saying, I have inserted the private sub
command and attached it to the click event in a form button that I named
"Import Excell Data". But you have typed in that you dont know the function
the "browse folder" is. What do you mean by function?
 
This line of code in the Comman1_Click procedure is where you set the type
of files that you can see:

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")


The above is setting the filter for EXCEL file. If you're not getting this
result, then it's likely that you've not set up the code correctly.

Create a new module; call it "basBrowse".

In that module, post all the code between the
'***************** Code Start **************

and the
'************** Code End *****************
from the web page that I provided to you.


In your form, while in design view, click on the button that will run the
code. Right click; choose Properties; select Event tab; click in box next to
Click; click on three-dot button at far right of box. Paste this code into
the VBEditor (between the Private Sub and the End Sub lines):


Dim strDirectory As String, strFilter As String
Dim strFileName As String, strInputFileName As String

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
strInputFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=True, _
DialogTitle:="Please select an input file...", _
Flags:=ahtOFN_HIDEREADONLY)
strDirectory = Left(strInputFileName, _
InStrRev(strInputFileName, "\")
strFileName = Dir(strDirectory & "*.xls")

Do While strFileName <> vbNullString
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"SomeTable", _
strDirectory & strFileName, True
strFileName = Dir()
Loop


As for BrowseFolder, in the code you'd originally posted, you had this line:
strDirectory = BrowseFolder("Select A Folder")

In the above code, you're calling a function named BrowseFolder and
returning its value to the variable strDirectory. I am not familiar with any
built-in VBA function named BrowseFolder, so that is why I asked what it is
supposed to be.
--

Ken Snell
<MS ACCESS MVP>




RA said:
Sorry for being such a pain with this. I have created the "open Dialog
box"
Module in the modules folder. However, it only alows me to search for
Access
Databases. Where do i change this so that it allows me to pull excell
files?

Also So I understand what your are saying, I have inserted the private sub
command and attached it to the click event in a form button that I named
"Import Excell Data". But you have typed in that you dont know the
function
the "browse folder" is. What do you mean by function?
Click to expand...


< snipped >
 
I recieved an email saying that there was a response to this post but I do
not see it here would you be able to repost that?
 
Microsoft's online website for posts was not working correctly until just
about 4 hours ago... you should be able to see the posts now.
 
I have set it up as you had shown only when I click the button I get a
compile error: sytax error
This part of the code is highlighted in red

strDirectory = Left(strInputFileName, _
InStrRev(strInputFileName, "\")

how do i fix that problem?
 
Sorry - I left off a trailing parenthesis:

strDirectory = Left(strInputFileName, _
InStrRev(strInputFileName, "\"))
 
I made the corrections to the code and have placed

Private Sub ExcellDataImport_Click()
Dim strDirectory As String, strFilter As String
Dim strFileName As String, strInputFileName As String

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
strInputFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=True, _
DialogTitle:="Please select an input file...", _
Flags:=ahtOFN_HIDEREADONLY)
strDirectory = Left(strInputFileName, _
InStrRev(strInputFileName, "\"))
strFileName = Dir(strDirectory & "*.xls")

Do While strFileName <> vbNullString
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"Client Data Averages", _
strDirectory & strFileName, True
strFileName = Dir()
Loop



End Sub

as a click event.....

my "basebrowse" module looks like

Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000


Function GetOpenFile(Optional varDirectory As Variant, _
Optional varTitleForDialog As Variant) As Variant
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
lngFlags = ahtOFN_FILEMUSTEXIST Or _
ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
If IsMissing(varDirectory) Then
varDirectory = ""
End If
If IsMissing(varTitleForDialog) Then
varTitleForDialog = ""
End If

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
varFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:=varTitleForDialog)
If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If
GetOpenFile = varFileName
End Function

Function ahtCommonFileOpenSave( _
Optional ByRef Flags As Variant, _
Optional ByVal InitialDir As Variant, _
Optional ByVal Filter As Variant, _
Optional ByVal FilterIndex As Variant, _
Optional ByVal DefaultExt As Variant, _
Optional ByVal FileName As Variant, _
Optional ByVal DialogTitle As Variant, _
Optional ByVal hwnd As Variant, _
Optional ByVal OpenFile As Variant) As Variant

Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
If IsMissing(InitialDir) Then InitialDir = CurDir
If IsMissing(Filter) Then Filter = ""
If IsMissing(FilterIndex) Then FilterIndex = 1
If IsMissing(Flags) Then Flags = 0&
If IsMissing(DefaultExt) Then DefaultExt = ""
If IsMissing(FileName) Then FileName = ""
If IsMissing(DialogTitle) Then DialogTitle = ""
If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
If IsMissing(OpenFile) Then OpenFile = True
strFileName = Left(FileName & String(256, 0), 256)
strFileTitle = String(256, 0)

With OFN
.lStructSize = Len(OFN)
.hwndOwner = hwnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.Flags = Flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
.hInstance = 0
.lpfnHook = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
If OpenFile Then
fResult = aht_apiGetOpenFileName(OFN)
Else
fResult = aht_apiGetSaveFileName(OFN)
End If

If fResult Then

If Not IsMissing(Flags) Then Flags = OFN.Flags
ahtCommonFileOpenSave = TrimNull(OFN.strFile)
Else
ahtCommonFileOpenSave = vbNullString
End If
End Function

Function ahtAddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String

If IsMissing(varItem) Then varItem = "*.*"
ahtAddFilterItem = strFilter & _
strDescription & vbNullChar & _
varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function

When I click on the Import Excell button I get the browse window and It
allows me to browse to the excell files that I am hoping to import. I then
click on a file and tell it to open that file, however, nothing imports. It
seems to be working as there are no errors that show up but I do not gain any
additional files and it does not loop through all of the excell files
contained within the folder. What have I done wrong here?
 
The full path to the file that the user selected is in strInputFileName.
That's what you need to use in your TransferSpreadsheet method. (You can get
rid of the DIr stuff)
 
What it is this group, and why is it appearing on my computer?

Yvonne Michele Anderson
(e-mail address removed)
 
Hello,

I am new to using macros and VBA, and am in need of some help. I've
been working on a spreadsheet that uses a button (I assign a macros to
it) to import data from a *.las file into an excel worksheet. Could
someone help me figure out how to allow the user to browse for and
select the *.las file to import, and then have excel paste the data in
a specific location in a worksheet?

I normally proceed to import the data as follows:
->Data -> Import External Data ->Import Data -> Select "All Files"
from the file type list, then I browse for and select the file -
Select Tab and Space as delimiters ->Select a Cell in an existing
Click to expand...
worksheet to import data -> OK

If someone could help me automate this, I would really appreciate it.
 
Back
Top