?
Solved

Help importing multiple excel files data into Access

Posted on 2008-06-12
5
Medium Priority
?
1,899 Views
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
xlApp.Quit
Set xlApp = Nothing
 
MsgBox "File created successfully: " & Path2 & "NFTS_Temp.xls", vbOKOnly, "File created"
End Sub

Open in new window

NFTS-REPORT1.xls
0
Comment
Question by:Michael Spellman
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
5 Comments
 
LVL 1

Expert Comment

by:plodernator
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
...
next

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!

Cheers

Nick aka plodernator

0
 

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.
Thanks
0
 
LVL 1

Accepted Solution

by:
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
            
            Do
            
                secCode = xlWS.Cells(fileLine, 1).Value
                If Len(secCode) = 0 Then
                    Exit Do 'blank seccode... exit this file
                End If
            
                tempTable.AddNew
                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
                tempTable.Update
                
                fileLine = fileLine + 1
            Loop
    
            Set xlWS = Nothing
            Set xlWB = Nothing
    
            'now you can move the file or delete it
            'fl.Move ProcessedFilePath
            'fl.Delete
 
        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
    xlApp.Quit
    Set xlApp = Nothing
     
    Screen.MousePointer = 0 'hourglass off
    
    MsgBox "Records imported ", vbOKOnly, "File created"
End Sub

Open in new window

Q01.zip
0
 

Author Closing Comment

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

Expert Comment

by:plodernator
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!
0

Featured Post

Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
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…
Suggested Courses

770 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