Copy data from Excel into MSAccess

I am trying to open a spreadsheet from MSAccess using VBA. I then want to select some cells on the spreadsheet to copy the data into an access table. At the moment I can't even get the code to select the cells on the spreadsheet to work. Can you help please?

Private Sub opwb()

Dim sPath As String
Dim sFile As String
Dim WorkbookToRead As String
Dim excelApp As Excel.Application
Dim wb As Excel.Workbook
Dim Flag As String
Dim strPath As String
Dim strAppFPSS As String
Dim strAppId As String
Dim fpHostnames As Variant
Dim strWorkSheetName As String
Dim hn As Range

strPath = "C:\temp\"
strAppFPSS = "Doc1"
strAppId = Mid(strAppFPSS, 1, InStr(1, strAppFPSS, " ") - 1)
strWorkBook = strPath & strAppFPSS & ".xlsx"
strWorkSheetName = "payments"
On Error Resume Next

Set excelApp = GetObject(, "Excel.Application")  ' - If Excel is not open, an error occurs and Err.Number > 0
                Flag = 1
If Err.Number <> 0 Then Set excelApp = CreateObject("Excel.Application") 'There is an error if Err.Number <> 0     Create Excel.Application

On Error GoTo Err_Handler
                Flag = 2

    With excelApp
        .Visible = True  'Excel becomes visible. Confirmed.
        Set wb = .Workbooks.Open(strWorkBook, ReadOnly:=True)
        Sheets(strWorkSheetName).Range(Selection, Selection.End(xlDown)).Select
    End With
    Set wb = Nothing
    Set excelApp = Nothing

    Exit Sub

    Set wb = Nothing
    Set excelApp = Nothing
    MsgBox Err.Description
    MsgBox "An error occurred while in Private Sub OpenExcelWorkbook(), called from cmdOpenExcelWorkbook_Click() | Flag = " & Flag
    Resume Exit_Sub

End Sub
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ian SturlandLogistics systems AnalystCommented:
is your excel sheet arranged in columns with headers or are you copying over individual cell contents ?
EDIT : I have an application that uses a workbook as the front end and copies data over to a background access table as well as reading it back in, this enables a multi user environment without linking access tables to excel

Below copies over specific cell data from excel to access but from within Excel

Public Sub Modify_Records()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, i As Long, LastRow As Long, ws As Worksheet, lr As Long, strsqlm As String, ref As String, wbbook As Workbook
'Set ws = Worksheets("log")
Set wbbook = ThisWorkbook
Set ws = wbbook.Worksheets("Lookups")
ref = ws.Range("Ag2").Value
'lr = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Dim strConn As String
strConn = "Provider=Microsoft.ace.OLEDB.12.0;" & " Data Source=Q:\Operations\Inventory Reports\New Third Party Files\Data.accdb;"

Set cn = New ADODB.Connection
cn.Mode = adModeShareDenyNone + adModeReadWrite
cn.Open strConn
Set rs = New ADODB.Recordset
strsqlm = "SELECT * FROM Data WHERE CheckField='" & ref & "'"
rs.Open strsqlm, cn, 2, adLockOptimistic, adCmdText

'For i = 3 To lr - 1
With rs

            .Fields("DateModified") = Format(Now(), "hh:nn:ss")
            '.Fields("DateAdded") = Now()
            .Fields("Plant") = Worksheets("lookups").Range("A1").Value
            .Fields("Remaining Case Var") = Worksheets("lookups").Range("V16").Value
            .Fields("Abs Opening Percentage") = Format(AbsopenPercent, "000.00")
            .Fields("SAP Total Cases") = SAPTotalCases
            .Fields("outstore total cases") = TPLCases
            .Fields("case var") = OpenCaseVar
            .Fields("Open Orders") = OpenOrderQty
            .Fields("Open Orders Comment") = OpenOrderQtyComments
            .Fields("Var 1") = Variance1
            .Fields("Var 2") = Variance2
            .Fields("Var 3") = Variance3
            .Fields("Var 4") = Variance4
            .Fields("Var 5") = Variance5
            .Fields("Var 1 Comment") = Variance1Comment
            .Fields("Var 2 Comment") = Variance2Comment
            .Fields("Var 3 Comment") = Variance3Comment
            .Fields("Var 4 Comment") = Variance4Comment
            .Fields("Var 5 Comment") = Variance5Comment
            .Fields("Remaining Var") = RemainingCaseVar
            .Fields("Abs Case Var") = AbsCaseVar
            .Fields("Batch Crossover") = BatchXovers
            .Fields("Batch Crossover Comment") = BatchXoversComment
            .Fields("Held Good Stk Crossover") = HeldGoodXovers
            .Fields("Held Good Stk Crossover Comment") = HeldGoodXoversComment
            .Fields("Remain Abs Case Var") = AbsRemainingCaseVar
            .Fields("Remain Abs Percent") = Format(RemainAbsPercentage, "000.00")
            .Fields("Nett Percent") = Format(NettPercent, "000.00")
            .Fields("CheckField") = Worksheets("lookups").Range("Ag2").Value
End With
'Next i

Set rs = Nothing
Set cn = Nothing

End Sub

Open in new window

jay_waughAuthor Commented:
Excel sheet arrange in columns with headers. I am looking to get all the data under a single header, but without the header.
Ian SturlandLogistics systems AnalystCommented:
ok you can do that i would suggest firstly creating a link table in access to your excel worksheet providing the layout remains constant, then you can use union queries to pull the data unto one column and append to another table

A simpler option if i understand it right would be to do as i suggested create a simple link table first, then use a select query to concatenate your columns into one using the & separator
Price Your IT Services for Profit

Managed service contracts are great - when they're making you money. Yes, you’re getting paid monthly, but is it actually profitable? Learn to calculate your hourly overhead burden so you can master your IT services pricing strategy.

Gustav BrockCIOCommented:
The easiest method is probably to open Excel, assign a Named Range to column A, save the workbook.

Then, in Access, link that Named Range as a linked table.
Finally, create a query that uses the linked table as source and filters on records where IsNumeric(F1)=True and assigns a meaningful alias to that field.

Now, use this query for your import or further processing.
jay_waughAuthor Commented:
I have to loop around about 400 spreadsheets so need to do this from MSAccess
Gustav BrockCIOCommented:
No need? Of course not, many methods can be used, but you wrote:

I am trying to open a spreadsheet from MSAccess using VBA.

So what are you actually trying to do, please?
jay_waughAuthor Commented:
Thanks Gustav you have a fair point :)

What I am trying to do is:-

I have 400 spreadsheets. I want to import the first column of each spreadsheet into a single msaccess table. I have the name and location of each spreadsheet in a single list. This table into which I import the spreadhseet data needs to have two columns. One which contains a concatenated list of all the values in column a of each spreadsheet. The other column needs to contain the first 7 characters of each Excel file's name (this data is not available in the spreasheet itself.)

The header value in column a of each spreadsheet contains [ and : characters so I cannot get the DOCMD.transferspreadsheet to work
Gustav BrockCIOCommented:
Could you provide a sample of such worksheet?
Does each worksheet belong to one or to separated workbooks?
jay_waughAuthor Commented:
Sadly I can't upload from where I am.

Yes each workbook belongs to seperate workbooks.


The spreadsheets are consistent in that worksheet 8 is called "confirmed purchases" and this is where I need to get the data from column A.

The header is [customer]:name and there could be any number of rows in this column.
jay_waughAuthor Commented:
The previous should have read:-

Sadly I can't upload from where I am.

 Yes each worksheet belongs to seperate workbooks.


 The spreadsheets are consistent in that worksheet 8 is called "confirmed purchases" and this is where I need to get the data from column A.

 The header is [customer]:name and there could be any number of rows in this column.
Using TransferSpreadsheet, just link to the spreadsheet.  You can then use an append query to select only the first column and append it to a local table.

We have bits and pieces of what you need to do but not a complete understanding.  Are you comfortable with VBA but just need ideas on how to attack the problem?  Are you looking for code that reads the files of a directory and opens them one at a time?  What do you need to do after you import that single column?  Do you need to move the processed files to a completed folder?  If not, how will you tell which files you have imported and which you haven't?  Would keeping a log table of imported files solve that problem so that you can bypass files that you have already processed.
jay_waughAuthor Commented:
Hi Pat,

Some code would be very useful if possible.

Tracking what's loaded into the table is not essential as I can quickly compare what is in the consolidated table against my original list of documents by using the column I mentioned which contains the first characters of the imported spreadsheets name.

Many thanks
Some code would be very useful if possible.
I have lots of useful code.  Exactly what do you need to do?  Originally, you said you needed to get specific cells.  That requires OLE automation code for Excel and someone posted some.  Later you said you wanted to import multiple tables but only the first column.  Have you tried what I suggested?  Use TransferSpreadsheet to link to the spreadsheet and an append query to copy the specific column from the linked table to your permanent table.

I'm not offering to write custom code for you but I have lots of working code that might be useful if only I knew the details of what you want to do.
jay_waughAuthor Commented:
I have moved forward with this but still can't quite get it to work. I can now upload my attempted code and would appreciate some assistance in finishing it off as I am still getting errors when importing and processing my data (simple as it maybe).

So my requirement is this.

I have a list or order numbers (circa400). Each order has an associated spreadsheet. One of the worksheets on each spreadsheet is a list of computers. I want to create a single list of Order numbers and associated computer hostnames.
When I try and import the spreadsheets into MSAccess I am having trouble as the header row in the original spreadsheets contains invalid characters such as [ and :. Hopefully the uploaded database and sample spreadsheets gives a good understanding of what I am trying.

Thanks Again

I had an assignment recently where I had to interface with the State of Connecticut and virtually every file they sent had something "wrong" with it.  Sometimes it was that the file names contained multiple "." which Access doesn't support or had a .dat extension which Access also doesn't support.  This fix up was to correct a column name that had a leading space.  Boy did Access not like that one!  I stripped out most of the import procedure except for the part that fixed up the Excel format and saved the file with a new name.  There is a comment on the line that changes the column header.  Once the file was fixed up and saved, I just imported it using TransferSpreadsheet
Private Sub cmdImport835CSV_Click()    

    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim sPath As String
    Dim sFileName As String
    Dim sExportName As String

   On Error GoTo Err_Proc

    ''automate Excel to reformat .xlxs to be a standard .xlsx instead of the bogus .xlsx created by HP grrrrrrrrrrrr!!!!!!!!!

    sPath = "your path"
    sFileName = "your file name"

    sExportName = sPath & sFileName & ".xlsx"

    Set xlApp = New Excel.Application
    Set xlWB = xlApp.Workbooks.Open(Me.txtFileName, , False)
    Set xlSheet = xlWB.Worksheets(1)
    xlApp.Visible = False
        Selection.NumberFormat = "@"
        xlSheet.Range("AJ1").Value = "Rendering Provider"           'field name has leading space in export so we have to fix it here
    xlWB.SaveAs FileName:=sExportName, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    xlWB.Close (False)
    Set xlWB = Nothing

    On Error GoTo 0
    Exit Sub


    Select Case Err.Number
        Case 3146
            MsgBox GetAllODBCErrors(), vbOKOnly
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdImport835_Click of VBA Document 
    End Select
Resume Exit_Proc
Exit Sub

Open in new window

John TsioumprisSoftware & Systems EngineerCommented:
Well this is a very quick and dirty as my office time has passed and i am heading home...but
Public Function CreateConsolList()
    Dim xl As Excel.Application
    Dim wb As Excel.Workbook
    Dim maxRow As Integer
    Dim i As Integer
    i = maxRow + 1
    Const StartRow = 1
    On Error GoTo ErrorHandler
    strSQL = "tblOrders"
                strInputFile = "The Path to your Excel"
                Set xl = CreateObject("Excel.Application")

                Set wb = xl.Workbooks.Open(strInputFile)
                For Each Sheet In wb.Sheets
                Debug.Print Sheet.Name
                    With Sheet
                        Debug.Print .Cells(1, 1)
                        If InStr(.Cells(1, 1), "[") Then
                            While Len(.Cells(i, 1)) > 0
                                Debug.Print .Cells(i, 1)
                            maxRow = i
                            i = i + 1
                        End If
                        End With
            Set rs = Nothing
            '..and set it to nothing
            Exit Function
            Resume ExitSub

End Function

Open in new window

Just make a simple INSERT or Recordset.AddNew on the Value of .Cells(i, 1) and you should be good to go...

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.