[Help]VBA Macro To Import Specific Cells from Excel to Access (1 Viewer)

mythandier

New member
Local time
Today, 12:36
Joined
Aug 8, 2012
Messages
1
Hello all,

I am currently working on writing a VB Macro that imports data from over 1000 Excel files into a single Access DB.

Right now, I'm using a DoCmd.TransferSpreadsheet Loop which works but due to how the Excel worksheets are formatted, it just isn't usable.

So what I need to do is the same type of function (can extract data from every .xls file in a specified file path) but ONLY pulls specific data from cells (ie, A8, A15, H29...etc). I need to pull the data from these cells into specific fields within Access so that: Field1 contains all data from all the A8 cells in all the worksheets, Field2 contains all data from all the A15 cells in all the worksheets...and so on.

The worksheet from each Excel file is not the first worksheet in the workbook so it has to be identified in the process.

If anyone can help I would be greatly appreciative.

I've included my current macro below. Please ignore all the From 1 To 1 nonsense since I am including that so that at a later date I may add additional worksheets or tables.

Regards,
CK

Code:
Sub AutomatedDataPull()

Dim strPathFile As String, strFile As String, strPath As String
Dim blnHasFieldNames As Boolean
Dim intWorksheets As Integer

' Replace X with the number of worksheets to be imported
' from each EXCEL file

Dim strWorksheets(1 To 1) As String

' Replace X with the number of worksheets to be imported
' from each EXCEL file (this code assumes that each worksheet
' with the same name is being imported into a separate table
' for that specific worksheet name)

Dim strTables(1 To 1) As String

' Replace generic worksheet names with the real worksheet names;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file

strWorksheets(1) = "Test Program .108.100"

' Replace generic table names with the real table names

strTables(1) = "Tracking"

' Change this next line to True if the first row in EXCEL worksheet
' has field names

blnHasFieldNames = False

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files

strPath = "C:\Access Test Docs\"

' Replace X with the number of worksheets to be imported
' from each EXCEL file

For intWorksheets = 1 To 1

      strFile = Dir(strPath & "*.xls")
      Do While Len(strFile) > 0
            strPathFile = strPath & strFile
            
            DoCmd.TransferSpreadsheet acImport, _
                  acSpreadsheetTypeExcel9, strTables(intWorksheets), _
                  strPathFile, blnHasFieldNames, _
                  strWorksheets(1) & "$"
            
            strFile = Dir()
      Loop

Next intWorksheets


End Sub
 

Users who are viewing this thread

Top Bottom