Help importing multiple excel files data into Access

Posted on 2008-06-12
Medium Priority
Last Modified: 2013-11-27
I get several excel files each month that I need to extract data from and put into Access:
Source folder = S:\NYC Reports\- Working Reports Folder\Inventory SWIP\Data_from_NFTS\Raw
Each worksheet will have different size data ranges, but all data begins in Cell A19
Column J should get the Run Date from the value in C10 of the source sheet.

The excel files each contain one worksheet called "RPT_VALFLIST.RPT"
The first 18 rows of data in the sheet are standard header info and column headers.
I do want to capture the Run Date which is in cell C10 and populate a new field with the date from each sheet (This will let me know the age of the data).

This is what I have.  It mostly works, except that the Run Date value comes in as 280.
Also, some programming explainations would be helpful.  I 'adapted' this from a previous solution.
If someone could add comments explaining what the steps do it would sure help my learning curve.
I'm assigning extra points to compensate for the extra commenting requested.

I will have other excel files to import that will be similar, but the ranges of data will vary and not every field in a row will have data.  

When I read multiple files, what ensures that the data is appended at the end of the current last row?
How do I account for the dynamic ranges in the source data?
Thanks in advance for your help.
Public Sub ExcelScan()
Dim xlApp As New Excel.Application
Dim xlWB As Excel.Workbook, xlWB2 As Excel.Workbook
Dim xlWS As Excel.Worksheet, xlWS2 As Excel.Worksheet
Dim xlRng As Excel.Range, xlRng1 As Excel.Range, xlRng2 As Excel.Range
Dim fso As New Scripting.FileSystemObject
Dim fl As File
Dim fls As Files
Dim fol As Folder
Dim q As Integer, v As Integer, w As Integer, x As Integer, y As Integer, z As Integer
'Source of raw NFTS Query output files xls
Const Filepath = "S:\NYC Reports\- Working Reports Folder\Inventory SWIP\Data_from_NFTS\Raw\"
'Location to save formatted NFTS data for importing to Access Database
Const Path2 = "S:\NYC Reports\- Working Reports Folder\Inventory SWIP\Data_from_NFTS\Ready\"
xlApp.Visible = False
Set xlWB2 = xlApp.Workbooks.Add
Set xlWS2 = xlWB2.Worksheets.Add
'Range for the column headers in the new sheet
Set xlRng1 = xlWS2.Range("A1", "J1")
'Need help here, I don't know how many rows I will end up with.
Set xlRng2 = xlWS2.Range("A2", "J1000")   'Need help here - destination range for the data to be copied
Set fol = fso.GetFolder(Filepath)
Set fls = fol.Files
'Set the Column Header Values in Columns A thu J
' reference format cells(row,column)
xlRng1.Cells(1, 1) = "SEC_CODE"
xlRng1.Cells(1, 2) = "DESC"
xlRng1.Cells(1, 3) = "RP_CODE"
xlRng1.Cells(1, 4) = "RP_DESC"
xlRng1.Cells(1, 5) = "FILE_NUMBER"
xlRng1.Cells(1, 6) = "RPC_ASSIGNED"
xlRng1.Cells(1, 7) = "LAST_ACTIVITY"
xlRng1.Cells(1, 8) = "LAST_AUDIT"
xlRng1.Cells(1, 9) = "STATUS"
xlRng1.Cells(1, 10) = "NFTS_DATE"
v = 1
For Each fl In fls
    Set xlWB = xlApp.Workbooks.Open(fl, False, False)
    Set xlWS = xlWB.Worksheets("RPT_VALFLIST.RPT")
    'Count the number of rows in sheet
    q = xlWS.Cells.Find(What:="*", LookIn:=-4163, LookAt:=1, SearchOrder:=1, SearchDirection:=2).Row
'I was going to use the value of q to set my range limit, but wasn't
' Sure how to do this, I got errors no matter what I tried.
'Does my current setting limit me to 10000 rows of data?     
    Set xlRng = xlWS.Range("A19", "J10000")
      For z = 1 To q Step 1
        If xlRng.Cells(z, 1) <> "" Then
            xlRng2.Cells(v, 1) = xlRng.Cells(z, 1)
            xlRng2.Cells(v, 2) = xlRng.Cells(z, 2).Value
            xlRng2.Cells(v, 3) = xlRng.Cells(z, 3).Value
            xlRng2.Cells(v, 4) = xlRng.Cells(z, 4).Value
            xlRng2.Cells(v, 5) = xlRng.Cells(z, 5).Value
            xlRng2.Cells(v, 6) = xlRng.Cells(z, 6).Value
            xlRng2.Cells(v, 7) = xlRng.Cells(z, 7).Value
            xlRng2.Cells(v, 8) = xlRng.Cells(z, 8).Value
            xlRng2.Cells(v, 9) = xlRng.Cells(z, 9).Value
            xlRng2.Cells(v, 10) = xlRng.Cells(10, 3).Value
            v = v + 1
        End If
      Next z
Next fl
' go through each file, copy the data from A19:J___    (to the last row of data)
' Need to set Column J = to the value found on the source worksheet in cell = C12  (Date mm/dd/yyyy)
' Repeat this for each workbook in the folder - copying the data and appending it at the bottom of the
' destination sheet
Set xlRng = Nothing
Set xlWS = Nothing
xlApp.DisplayAlerts = False
xlWB2.SaveAs Path2 & "NFTS_Temp.xls"
xlApp.DisplayAlerts = True
Set xlRng = Nothing
Set xlRng2 = Nothing
Set xlWS2 = Nothing
Set xlWB = Nothing
Set xlWB2 = Nothing
Set xlApp = Nothing
MsgBox "File created successfully: " & Path2 & "NFTS_Temp.xls", vbOKOnly, "File created"
End Sub

Open in new window

Question by:Michael Spellman
  • 3
  • 2

Expert Comment

ID: 21774095
Hi mspellm,

The best way to edit this sort of VBA is in the Excel macro window (Alt-F11).

To do this you'll need to create a reference to the Microsoft Scripting Object
(Tools-References add Microsoft Scripting Runtime) because it's used by this line:
Dim fso As New Scripting.FileSystemObject
(and other lines following. This is a good object to get a list of files).

But let's go through the code, answering each question as we come to it...

xlWS2 is obviously your target worksheet, and the destination range is limited to 1000 rows.
Life's too short to mess around programming this... if that's not enough, change it to 2000, or 4000.

The row position that you're writing to is variable v. We can look at this afterwards
to check it's less than 1000.

I assume you're OK with this construct, which lets you work with each selected input workbook in turn.
For Each fl In fls

The most difficult-looking line is this one:
q = xlWS.Cells.Find(What:="*", LookIn:=-4163, LookAt:=1, SearchOrder:=1, SearchDirection:=2).Row
'All it does is find the last row that's populated.
The original author isn't a genius: he just recorded a macro to select to the end of the range
and copied the generated code.
(well he may be a genius as well...)

If you are determined to just read the data you need, use
Set xlRng = xlWS.Range("A19", "J" & q)

The reason you get errors is that this loop is wrong:
      For z = 1 To q Step 1

xlRng is actually rows 19 to q.
In the above loop, z goes from 1 to q, so the last 18 times round are off the end of the data.
That's why there is the check for
        If xlRng.Cells(z, 1) <> "" Then 'nn yes but the last 19 rows are blank

The loop statement should be
      For z = 1 To (q-18) Step 1

Remember v? that's how we know which row we're writing to in
      xlRng2.Cells(v, 1) = xlRng.Cells(z, 1)

The reason you're getting 280 in the date box is as follows:
The final assignment is wrong:
            xlRng2.Cells(v, 10) = xlRng.Cells(10, 3).Value 'WRONG
That gives you cell 10,3 in the selected range (starting from A19).
You want cell 10,3 in the worksheet (starting from A1)
            xlRng2.Cells(v, 10) = xlWS.Cells(10, 3).Value
            'nn no you want cell 10,3 in the WORKSHEET not the selected range

If you are worried about going over 1000 lines you could put a check in here

if v > 999 then
      msgbox "Spreadsheet Import Error: Upgrade Required. Contact Support on this premium rate number..."
      exit sub
end if

For extra credit I might suggest:
-Write to a trace or log file, with the number of files and lines processed.
-Alter the code to just read down the spreadsheet from A19, stopping when it comes to a blank row.
-Put in error trapping to log errors and display an informative error message.
-Copy the incoming block of data and paste it in one operation, rather than going through line by line.
-Moving processed files to a Processed folder
-Saving the output file with a sequential number (01, 02...)

Why are you writing from one excel spreadsheet to another? as you asked this in the Access forum,
are you going to import this spreadsheet into Access? You could read in to a temporary table instead
of involving additional files.

Anyhow, thanks for posting such a clear question and I hope this helps!


Nick aka plodernator


Author Comment

by:Michael Spellman
ID: 21774610
Nick aka plodernator,

Thanks for the help.  I do want to bring this spreadsheet data into an access table.  I was just trying to get it consolidated and formatted first.  As a newbie, I am just sliding on the ice - trying to find 'a way' to get what I need done.
I'd certainly like to eliminate any extra steps - by reading this into a temp table.  Some of my source spreadsheets will have over ten thousand rows, so that certainly sounds better.
If you could help me do that - putting the data ito a temp file with the explanations, I would be appreciative.

Accepted Solution

plodernator earned 2000 total points
ID: 21784635
HI mspellm,
writing a sensible reply is more difficult than you might think,so please ask if this doesn't make sense.
Taking the original, we will go thru the files and open each workbook in turn.
Then we'll look thru the lines, starting at A19 and stopping when we come to a blank cell.
We will then put that data into a table in the current database.

We still need error handling, decent feedback messages, a button on a form to kick this all off etc. but you can trace this through and see what's happening.
Option Compare Database
Option Explicit
Public Sub ExcelScan()
    'Scans for Excel files and imports into a table in the current database
    'From a macro by mspellm on Experts Exchange
    'Extensively modified by Nick Ajderian, nick@hattjoys.co.uk 14 June 08
    'nn: Make sure this compiles first... this checks that you've got the references set up
    'nn The idea is to read teh spreadsheets in, line by line, to a temporary table.
    'Less efficient but you can set breakpoints and experiment with different ways
    'of handling problems at each line.
    'All the fields in this table are text so you don't get problems converting data types
    'at this stage. Also we're going to log the incoming file name and line number.
    'You need to validate the contents of this temp table and then move the data to the
    'live system. However, as you're in Access land you can easily produce reports
    'showing number of lines processed, total values transferred etc.
    'create a table NFTS to hold the fields: add fileName and fileLine for logging, and an ID field is
    'usually handy
    'sql = "create table NFTS (ID counter primary key,SEC_CODE varchar(20),[DESC] varchar(20), RP_CODE varchar(20),  RP_DESC varchar(20),  FILE_NUMBER varchar(20),  RPC_ASSIGNED varchar(20),  LAST_ACTIVITY varchar(20),  LAST_AUDIT varchar(20),  STATUS varchar(20),  NFTS_DATE  varchar(20), fileName varchar(255), fileLine int) "
    'CurrentDb.Execute sql
    'I've removed all references to the output workbook
    Screen.MousePointer = 11 'hourglass on
    Dim xlApp As New Excel.Application 'requires a ref to Microsoft Excel Object Model
    Dim xlWB As Excel.Workbook
    Dim xlWS As Excel.Worksheet
    Dim fso As New Scripting.FileSystemObject 'requires ref to Microsoft Scripting Runtime
    Dim fl As File
    Dim fls As Files
    Dim fol As Folder
    'Source of raw NFTS Query output files xls
    'Const Filepath = "S:\NYC Reports\- Working Reports Folder\Inventory SWIP\Data_from_NFTS\Raw\"
    Const Filepath = "C:\projects\ExpertsExchange\"
    Const ProcessedFilePath = "C:\projects\ExpertsExchange\Processed"
    xlApp.Visible = True 'was False
    Set fol = fso.GetFolder(Filepath)
    Set fls = fol.Files
    Dim sql As String
    Dim tempTable As DAO.Recordset
    Set tempTable = CurrentDb.OpenRecordset("NFTS", dbOpenDynaset, dbAppendOnly)
    For Each fl In fls
        If fl Like Filepath & "NFTS*.xls" Then 'if the file matches the pattern we want
            Set xlWB = xlApp.Workbooks.Open(fl, False, False) 'open the workbook
            Set xlWS = xlWB.Worksheets("RPT_VALFLIST.RPT")
            'Count the number of rows in sheet
            q = xlWS.Cells.Find(What:="*", LookIn:=-4163, LookAt:=1, SearchOrder:=1, SearchDirection:=2).Row
            'I was going to use the value of q to set my range limit, but wasn't
            ' Sure how to do this, I got errors no matter what I tried.
            'Does my current setting limit me to 10000 rows of data?
            'nn I'm going to start at A19 and work downwards, stopping when I find a blank
            Dim fileLine As Integer
            Dim secCode As String
            Dim runDate As Date
            fileLine = 19
            runDate = xlWS.Cells(10, 3).Value
                secCode = xlWS.Cells(fileLine, 1).Value
                If Len(secCode) = 0 Then
                    Exit Do 'blank seccode... exit this file
                End If
                tempTable!SEC_CODE = xlWS.Cells(fileLine, 1)
                tempTable![DESC] = xlWS.Cells(fileLine, 2).Value
                tempTable!RP_CODE = xlWS.Cells(fileLine, 3).Value
                tempTable!RP_DESC = xlWS.Cells(fileLine, 4).Value
                tempTable!FILE_NUMBER = xlWS.Cells(fileLine, 5).Value
                tempTable!RPC_ASSIGNED = xlWS.Cells(fileLine, 6).Value
                tempTable!LAST_ACTIVITY = xlWS.Cells(fileLine, 7).Value
                tempTable!LAST_AUDIT = xlWS.Cells(fileLine, 8).Value
                tempTable!Status = xlWS.Cells(fileLine, 9).Value
                tempTable!NFTS_DATE = runDate
                tempTable!FileName = fl
                tempTable!fileLine = fileLine
                fileLine = fileLine + 1
            Set xlWS = Nothing
            Set xlWB = Nothing
            'now you can move the file or delete it
            'fl.Move ProcessedFilePath
        End If
    Next fl
proc_exit: 'you will need this when you implement error handling!
    'this is where the cleanup code happens
    Set tempTable = Nothing
    Set xlWS = Nothing
    xlApp.DisplayAlerts = False
    xlApp.DisplayAlerts = True
    Set xlWB = Nothing
    Set xlApp = Nothing
    Screen.MousePointer = 0 'hourglass off
    MsgBox "Records imported ", vbOKOnly, "File created"
End Sub

Open in new window


Author Closing Comment

by:Michael Spellman
ID: 31466713
Thanks Nick.  That helps a lot.  I appreciate it.

Expert Comment

ID: 21801901
you are very welcome, and many thanks for my very first points!
You will of course have different files: your code can look at the cells to decide what type of incoming file you are dealing with and write an if statement to handle it appropriately. Let us know how you get on!

Featured Post

Get 10% Off Your First Squarespace Website

Ready to showcase your work, publish content or promote your business online? With Squarespace’s award-winning templates and 24/7 customer service, getting started is simple. Head to Squarespace.com and use offer code ‘EXPERTS’ to get 10% off your first purchase.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
Instead of error trapping or hard-coding for non-updateable fields when using QODBC, let VBA automatically disable them when forms open. This way, users can view but not change the data. Part 1 explained how to use schema tables to do this. Part 2 h…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

607 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question