Advertisement

06.12.2008 at 12:29PM PDT, ID: 23480799
[x]
Attachment Details

Help importing multiple excel files data into Access

Asked by mspellm in Access Coding/Macros, VB Script

Tags: , ,

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.Start Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:

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
Attachments:
 
NFTS-REPORT1.xls (744 KB) (File Type Details) 
Example Data for import.
 
[+][-]06.12.2008 at 03:04PM PDT, ID: 21774095

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]06.12.2008 at 04:45PM PDT, ID: 21774610

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]06.14.2008 at 01:58AM PDT, ID: 21784635

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zones: Access Coding/Macros, VB Script
Tags: Microsoft, Access, 2003
Sign Up Now!
Solution Provided By: plodernator
Participating Experts: 1
Solution Grade: A
 
 
[+][-]06.17.2008 at 04:47AM PDT, ID: 21801901

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628