Import to Specific Excel Sheet from Access via VBA - excel

I am trying to figure out how to get data that I am importing into Excel from an Access table to import into a specific sheet (Either a sheet just called Sheet 2 or Access Data). I have the following code to get the data and to format it the way I want after import, but I can't get it to import into a specific sheet. Can I get assistance? Here's what I have:
Update to the code with resolution:
Sub getAccessData()
Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
Dim lngLastColumn As Long
Dim lngLastRow As Long
Dim OXLSheet As Worksheet
Set OXLSheet = Worksheets("WorksheetName")
Worksheets("WorksheetName").Cells.Clear
'Datebase path info
DBFullName = "C:\Users\myname\Desktop\Database Backups\database.accdb"
'Open the connection for the database
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect
'Create RecordSet
Set Recordset = New ADODB.Recordset
With Recordset
'Data Filter
Source = "SELECT * FROM tblRetirements WHERE [AllowEnteredInPayroll] Is Null AND ApplicationCancelled = 'No'"
.Open Source:=Source, ActiveConnection:=Connection
'Write field Names
For Col = 0 To Recordset.Fields.Count - 1
Worksheets("WorksheetName").Range("A5").Offset(0, Col).Value = Recordset.Fields(Col).Name
Next
'Write Recordset
Worksheets("WorksheetName").Range("A5").Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
With OXLSheet
lngLastColumn = .Cells(5, .Columns.Count).End(xlToLeft).Column
lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.ListObjects.Add(xlSrcRange, .Range(.Cells(5, 1), .Cells(lngLastRow, lngLastColumn)), , xlYes).Name = "Table1"
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium16"
End With
End Sub
Thank you.

There is a typo, SELECT*FROM, should be SELECT * FROM.
If you want to import into a specific sheet, name output, please try replace:
Range("A5").Offset(0, Col).Value = Recordset.Fields(Col).Name with Worksheets("output").Range("A5").Offset(0, Col).Value = Recordset.Fields(Col).Name
Range("A5").Offset(1, 0).CopyFromRecordset Recordset with Worksheets("output").Range("A5").Offset(1, 0).CopyFromRecordset Recordset

If you want to copy your data in a specific worksheet, for instance named Sheet2
' Declare a worksheet object
Dim objSheet As Worksheet
' initialize it
Set objSheet = ActiveWorkbook.Sheets("Sheet2")
'Write field Names
For Col = 0 To Recordset.Fields.Count - 1
objSheet.Range("A5").Offset(0, Col).Value = Recordset.Fields(Col).Name
Next
'Write Recordset
objSheet.Range("A5").Offset(1, 0).CopyFromRecordset Recordset

Here is generic code to import the data from specific worksheets in all EXCEL files (worksheet names are the same in all files) that are located within a single folder. All of the EXCEL files' worksheets with the same worksheet names must have the data in the same layout and format.
Sub TryThis()
Dim strPathFile As String, strFile As String, strPath As String
Dim blnHasFieldNames As Boolean
Dim intWorksheets As Integer
' Replace 3 with the number of worksheets to be imported
' from each EXCEL file
Dim strWorksheets(1 To 3) As String
' Replace 3 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 3) 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) = "GenericWorksheetName1"
strWorksheets(2) = "GenericWorksheetName2"
strWorksheets(3) = "GenericWorksheetName3"
' Replace generic table names with the real table names;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file
strTables(1) = "GenericTableName1"
strTables(2) = "GenericTableName2"
strTables(3) = "GenericTableName3"
' 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:\Documents\"
' Replace 3 with the number of worksheets to be imported
' from each EXCEL file
For intWorksheets = 1 To 3
strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, _
acSpreadsheetTypeExcel9, strTables(intWorksheets), _
strPathFile, blnHasFieldNames, _
strWorksheets(intWorksheets) & "$"
strFile = Dir()
Loop
Next intWorksheets
End Sub

Related

Import from closed workbook in order of sheets ADODB

As to me, ADODB is something new for me that I am eager to learn. Here's a code that I tried my best but needs your ideas to make it appear more professional and more efficient. The problem in the code is that the data is grabbed from sheets in reverse order and not in the order of sheets. To make it clear, I have Sample.xlsx workbook with two sheets Sheet1 and New and the code is supposed to loop through t he sheets then search for specific header then to get the data from such a column. All this with the ADO approach. the code grabs the data from New sheet first then from Sheet1 .. While the order of the sheets is Sheet1 then New >> another point, how can I close the recordset properly. I mean is using .Close is enough or I have to set it to Nothing Set rs=Nothing.
Sub ImportFromClosedWorkbook()
Dim e, ws As Worksheet, cn As ADODB.Connection, rs As ADODB.Recordset, rsHeaders As ADODB.Recordset, b As Boolean, sFile As String, shName As String, strSQL As String, iCol As Long
sFile = ThisWorkbook.Path & "\Sample.xlsx"
'shName = "Sheet1"
Dim rsData As ADODB.Recordset
Set cn = New ADODB.Connection
cn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & sFile & "';" & "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";"
'--------
Set ws = ThisWorkbook.ActiveSheet
Set rs = cn.OpenSchema(20)
Do While Not rs.EOF
sName = rs.Fields("Table_Name")
If Right(sName, 14) <> "FilterDatabase" Then
sName = Left(sName, Len(sName) - 1)
'Debug.Print sName
b = False
strSQL = "SELECT * FROM [" & sName & "$]"
Set rsHeaders = New ADODB.Recordset
rsHeaders.Open Source:=strSQL, ActiveConnection:=cn, Options:=1
For iCol = 0 To rsHeaders.Fields.Count - 1
'Debug.Print rsHeaders.Fields(iCol).Name
For Each e In Array("Ref No", "Reference", "Number")
If e = rsHeaders.Fields(iCol).Name Then
b = True: Exit For
End If
Next e
If b Then Exit For
Next iCol
If b Then
'Debug.Print e
strSQL = "SELECT [" & e & "] FROM [" & sName & "$]"
Set rsData = New ADODB.Recordset
Set rsData = cn.Execute(strSQL)
ws.Range("A" & ws.Cells(Rows.Count, 1).End(xlUp).Row + 1).CopyFromRecordset rsData
rsData.Close
'here I am stuck of how to get the data from the found column
End If
'rs.Close
End If
rs.MoveNext
Loop
'rs.Close
'------------------
' strSQL = "SELECT * FROM [" & shName & "$]"
' Set rs = New ADODB.Recordset
' Set rs = cn.Execute(strSQL)
' Range("A1").CopyFromRecordset rs
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
End Sub
the code grabs the data from New sheet first then from Sheet1 .. While the order of the sheets is Sheet1 then New
The tab order is an Excel feature. The Sheet names are extracted in alphabetical order when you use ADODB. This is the reason why you get New sheet first and then Sheet1.
Note: If the sheet names start with number or have spaces then they are given a priority first. Few examples
Example 1
Sheets names: 1, Sheet1, 1Sheet4, She et3, Sheet5
Returned as
'1$'
'1Sheet4$'
'She et3$'
Sheet1$
Sheet5$
Example 2
Sheets names: Sheet2, Sheet5, She et3, Sheet1, Sheet4
Returned as
'She et3$'
Sheet1$
Sheet2$
Sheet4$
Sheet5$
Example 3
Sheets names: 1, Sheet1, 2, Sheet2, 3, Sheet3
Returned as
'1$'
'2$'
'3$'
Sheet1$
Sheet2$
Sheet3$
Alternative to ADODB
If you want to extract the names of the sheets in the tab order then you can use DAO as shown by Andrew Poulsom in THIS link. Posting the code here in case the link dies...
Sub GetSecondSheetName()
' Requires a reference to Microsoft DAO x.x Object Library
' Adjust to suit
Const FName As String = "P:\Temp\MrExcel\Temp\SheetNames.xls"
Dim WB As DAO.Database
Dim strSheetName As String
Set WB = OpenDatabase(FName, False, True, "Excel 8.0;")
' TableDefs is zero based
strSheetName = WB.TableDefs(1).Name
MsgBox strSheetName
WB.Close
End Sub
Close is enough or I have to set it to Nothing Set rs=Nothing.
No you do not have to set it to nothing. VBA cleans it automatically when it exits the prodecure. But yes it is a good practice to flush the toilet.
Interesting Read:
You may want to read the post by #GSerg in the below link...
When should an Excel VBA variable be killed or set to Nothing?
For it to work with XLSX, use this (Requires a reference to Microsoft Office XX.XX Access database engine Object Library)
Option Explicit
'~~> Change this to the relevant file name
Const FName As String = "C:\Users\routs\Desktop\Delete Me later\TEXT.XLSX"
Sub Sample()
'Requires a reference to Microsoft Office XX.XX Access database engine Object Library
Dim db As DAO.Database
Set db = OpenDatabase(FName, False, False, "Excel 12.0")
Dim i As Long
For i = 0 To db.TableDefs.Count - 1
Debug.Print db.TableDefs(i).Name
Next i
db.Close
End Sub
In Action
#Siddharth Rout you have inspired me how to search for such new topic for me and I could use such a code to list all the worksheets in the order of tab using DAO but with late binding ( I am curious to know how to use early binding as I tried but with no success)
Sub Get_Worksheets_Using_DAO()
Dim con As Object, db As Object, sName As String, i As Long
Set con = CreateObject("DAO.DBEngine.120")
sName = ThisWorkbook.Path & "\Sample.xlsx"
Set db = con.OpenDatabase(sName, False, True, "Excel 12.0 XMl;")
For i = 0 To db.TableDefs.Count - 1
Debug.Print db.TableDefs(i).Name
Next i
db.Close: Set db = Nothing: Set con = Nothing
End Sub

How do I read a closed excel using VBA?

I have a collection of .xls files in one folder. I wish to use VBA to extract values from these .xls while the files are closed.
If you are familiar with SQL then you can run queries against Excel files to get the data. It is much faster than opening an Excel file, but the data in your excel files needs to be well organized like a SQL table. Here is an example.
Write SQL query on excel tables
Import data from a closed workbook (ADO)
If you want to import a lot of data from a closed workbook you can do this with ADO and the macro below. If you want to retrieve data from another worksheet than the first worksheet in the closed workbook, you have to refer to a user defined named range. The macro below can be used like this (in Excel 2000 or later):
GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "A1:B21", ActiveCell, False
GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "MyDataRange", Range ("B3"), True
Sub GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, _
TargetRange As Range, IncludeFieldNames As Boolean)
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
' this will return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
' this will return data from any worksheet in SourceFile
' SourceRange must include the range headers
'
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
Dim TargetCell As Range, i As Integer
dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
"ReadOnly=1;DBQ=" & SourceFile
Set dbConnection = New ADODB.Connection
On Error GoTo InvalidInput
dbConnection.Open dbConnectionString ' open the database connection
Set rs = dbConnection.Execute("[" & SourceRange & "]")
Set TargetCell = TargetRange.Cells(1, 1)
If IncludeFieldNames Then
For i = 0 To rs.Fields.Count - 1
TargetCell.Offset(0, i).Formula = rs.Fields(i).Name
Next i
Set TargetCell = TargetCell.Offset(1, 0)
End If
TargetCell.CopyFromRecordset rs
rs.Close
dbConnection.Close ' close the database connection
Set TargetCell = Nothing
Set rs = Nothing
Set dbConnection = Nothing
On Error GoTo 0
Exit Sub
InvalidInput:
MsgBox "The source file or source range is invalid!", _
vbExclamation, "Get data from closed workbook"
End Sub
Another method that doesn't use the CopyFromRecordSet-method
With the macro below you can perform the import and have better control over the results returned from the RecordSet.
Sub TestReadDataFromWorkbook()
' fills data from a closed workbook in at the active cell
Dim tArray As Variant, r As Long, c As Long
tArray = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21")
' without using the transpose function
For r = LBound(tArray, 2) To UBound(tArray, 2)
For c = LBound(tArray, 1) To UBound(tArray, 1)
ActiveCell.Offset(r, c).Formula = tArray(c, r)
Next c
Next r
' using the transpose function (has limitations)
' tArray = Application.WorksheetFunction.Transpose(tArray)
' For r = LBound(tArray, 1) To UBound(tArray, 1)
' For c = LBound(tArray, 2) To UBound(tArray, 2)
' ActiveCell.Offset(r - 1, c - 1).Formula = tArray(r, c)
' Next c
' Next r
End Sub
Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As String) As Variant
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
' this function can only return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
' this function can return data from any worksheet in SourceFile
' SourceRange must include the range headers
' examples:
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:A21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "DefinedRangeName")
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & SourceFile
Set dbConnection = New ADODB.Connection
On Error GoTo InvalidInput
dbConnection.Open dbConnectionString ' open the database connection
Set rs = dbConnection.Execute("[" & SourceRange & "]")
On Error GoTo 0
ReadDataFromWorkbook = rs.GetRows ' returns a two dim array with all records in rs
rs.Close
dbConnection.Close ' close the database connection
Set rs = Nothing
Set dbConnection = Nothing
On Error GoTo 0
Exit Function
InvalidInput:
MsgBox "The source file or source range is invalid!", vbExclamation, "Get data from closed workbook"
Set rs = Nothing
Set dbConnection = Nothing
End Function
http://www.erlandsendata.no/english/index.php?d=envbadacimportwbado
&
https://www.rondebruin.nl/win/s3/win024.htm

Not able to pull records from access to excel, Probable connection issue

I using the below code to pull records from access to excel.
I am getting error at
connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB
The error says"invalid sql statement, delete, insert,procedure,selet or update"
Kindly help as I am stuck and cannot move forward at all....
please help.
Sub automateAccessADO_9()
'Using ADO to Import data from an Access Database Table to an Excel worksheet (your host application).
'refer Image 9a to view the existing SalesManager Table in MS Access file "SalesReport.accdb".
'To use ADO in your VBA project, you must add a reference to the ADO Object Library in Excel (your host application) by clicking Tools-References in VBE, and then choose an appropriate version of Microsoft ActiveX Data Objects x.x Library from the list.
'--------------
'DIM STATEMENTS
Dim strMyPath As String, strDBName As String, strDB As String, strSQL As String
Dim i As Long, n As Long, lFieldCount As Long
Dim rng As Range
'instantiate an ADO object using Dim with the New keyword:
Dim adoRecSet As New ADODB.Recordset
Dim connDB As New ADODB.Connection
'--------------
'THE CONNECTION OBJECT
strDBName = "Computer.accdb"
strMyPath = ThisWorkbook.Path
strDB = strMyPath & "\" & strDBName
'Connect to a data source:
'For pre - MS Access 2007, .mdb files (viz. MS Access 97 up to MS Access 2003), use the Jet provider: "Microsoft.Jet.OLEDB.4.0". For Access 2007 (.accdb database) use the ACE Provider: "Microsoft.ACE.OLEDB.12.0". The ACE Provider can be used for both the Access .mdb & .accdb files.
connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB
'--------------
'OPEN RECORDSET, ACCESS RECORDS AND FIELDS
Dim ws As Worksheet
'set the worksheet:
Set ws = ActiveWorkbook.Sheets("Sheet1")
'Set the ADO Recordset object:
Set adoRecSet = New ADODB.Recordset
'Opening the table named SalesManager:
strTable = "memory"
'--------------
'COPY RECORDS FROM ALL FIELDS OF A RECORDSET:
'refer Image 9d to view records copied to Excel worksheet
adoRecSet.Open Source:=strTable, ActiveConnection:=connDB, CursorType:=adOpenStatic, LockType:=adLockOptimistic
Set rng = ws.Range("A1")
lFieldCount = adoRecSet.Fields.Count
For i = 0 To lFieldCount - 1
'copy column names in first row of the worksheet:
rng.Offset(0, i).Value = adoRecSet.Fields(i).Name
adoRecSet.MoveFirst
'copy record values starting from second row of the worksheet:
n = 1
Do While Not adoRecSet.EOF
rng.Offset(n, i).Value = adoRecSet.Fields(i).Value
adoRecSet.MoveNext
n = n + 1
Loop
Next i
'select column range to AutoFit column width:
Range(ws.Columns(1), ws.Columns(lFieldCount)).AutoFit
'worksheet columns are deleted because this code is only for demo:
Range(ws.Columns(1), ws.Columns(lFieldCount)).Delete
adoRecSet.Close
'close the objects
connDB.Close
'destroy the variables
Set adoRecSet = Nothing
Set connDB = Nothing
End Sub
When going from Access to Excel, you have quite a few options!
Here's one way to EXPORT data from Access to Excel.
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
blnEXCEL = False
' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = True
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = True
' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file into which you will write the data
Set xlw = xlx.Workbooks.Open("C:\Filename.xls")
' Replace WorksheetName with the actual name of the worksheet
' in the EXCEL file
' (note that the worksheet must already be in the EXCEL file)
Set xls = xlw.Worksheets("WorksheetName")
' Replace A1 with the cell reference into which the first data value
' is to be written
Set xlc = xls.Range("A1") ' this is the first cell into which data go
Set dbs = CurrentDb()
' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
Set rst = dbs.OpenRecordset("QueryOrTableName", dbOpenDynaset, dbReadOnly)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1,0)
End If
' write data to worksheet
Do While rst.EOF = False
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1,0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
' Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close True ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
Here's another way.
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strPathFileName As String, strWorksheetName As String
Dim strRecordsetDataSource As String
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
blnEXCEL = False
' Replace C:\Filename.xls with the actual path and filename
' that will be used to save the new EXCEL file into which you
' will write the data
strPathFileName = "C:\Filename.xls"
' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
strRecordsetDataSource = "QueryOrTableName"
' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = True
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = True
' Create a new EXCEL workbook
Set xlw = xlx.Workbooks.Add
' Rename the first worksheet in the EXCEL file to be the first 31
' characters of the string in the strRecordsetDataSource variable
Set xls = xlw.Worksheets(1)
xls.Name = Trim(Left(strRecordsetDataSource, 31))
' Replace A1 with the cell reference of the first cell into which the
' headers will be written (blnHeaderRow = True), or into which the data
' values will be written (blnHeaderRow = False)
Set xlc = xls.Range("A1")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset(strRecordsetDataSource, dbOpenDynaset, dbReadOnly)
If rst.EOF = False And rst.BOF = False Then
' Write the header row to worksheet
If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1,0)
End If
' copy the recordset's data to worksheet
xlc.CopyFromRecordset rst
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
' Save and close the EXCEL file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.SaveAs strPathFileName
xlw.Close False
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
Here's a way to IMPORT date from Access to Excel.
Sub ADOImportFromAccessTable(DBFullName As String, _
TableName As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
"TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
.Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
' all records
'.Open "SELECT * FROM " & TableName & _
" WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText
' filter records
RS2WS rs, TargetRange ' write data from the recordset to the worksheet
' ' optional approach for Excel 2000 or later (RS2WS is not necessary)
' For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
' TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
' Next
' TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Here's one more way to IMPORT your data.
Sub DAOCopyFromRecordSet(DBFullName As String, TableName As String, _
FieldName As String, TargetRange As Range)
' Example: DAOCopyFromRecordSet "C:\FolderName\DataBaseName.mdb", _
"TableName", "FieldName", Range("C1")
Dim db As Database, rs As Recordset
Dim intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
Set db = OpenDatabase(DBFullName)
Set rs = db.OpenRecordset(TableName, dbOpenTable) ' all records
'Set rs = db.OpenRecordset("SELECT * FROM " & TableName & _
" WHERE " & FieldName & _
" = 'MyCriteria'", dbReadOnly) ' filter records
' write field names
For intColIndex = 0 To rs.Fields.Count - 1
TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next
' write recordset
TargetRange.Offset(1, 0).CopyFromRecordset rs
Set rs = Nothing
db.Close
Set db = Nothing
End Sub

import excel file using something similiar to QueryTable?

To import data into an excel file, QueryTable is quite convenient when the source is a .csv file, e.g. Import csv with quoted newline using QueryTables in Excel , however it does not work with excel sources.
Importing an excel file can be done by VBA, just wonder, if there's something convenient as QueryTable, to import from a excel file, s.t. only need to specify the source file name, sheet name or range name?
Oh, I see. Ok, well, you can use VBA to import data from Worksheets into your Workbook.
' Get customer workbook...
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook
' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
' assume range is A1 - C10 in sheet1
' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)
targetSheet.Range("A1", "C10").Value = sourceSheet.Range("A1", "C10").Value
' Close customer workbook
customerWorkbook.Close
Or, you can use the Query tool to import data from another Excel file.
http://dailydoseofexcel.com/archives/2004/12/13/parameters-in-excel-external-data-queries/
I'm guessing you are importing data from Access into excel. I don't think you specified your source, or I couldn't make it out. My eyes are not as good as they used to be...
Anyway, consider this option.
Sub ADOImportFromAccessTable(DBFullName As String, _
TableName As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
"TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
.Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
' all records
'.Open "SELECT * FROM " & TableName & _
" WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText
' filter records
RS2WS rs, TargetRange ' write data from the recordset to the worksheet
' ' optional approach for Excel 2000 or later (RS2WS is not necessary)
' For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
' TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
' Next
' TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Or, this.
Sub RS2WS(rs As ADODB.Recordset, TargetCell As Range)
Dim f As Integer, r As Long, c As Long
If rs Is Nothing Then Exit Sub
If rs.State <> adStateOpen Then Exit Sub
If TargetCell Is Nothing Then Exit Sub
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.StatusBar = "Writing data from recordset..."
End With
With TargetCell.Cells(1, 1)
r = .Row
c = .Column
End With
With TargetCell.Parent
.Range(.Cells(r, c), .Cells(.Rows.Count, c + rs.Fields.Count - 1)).Clear
' clear existing contents
' write column headers
For f = 0 To rs.Fields.Count - 1
On Error Resume Next
.Cells(r, c + f).Formula = rs.Fields(f).Name
On Error GoTo 0
Next f
' write records
On Error Resume Next
rs.MoveFirst
On Error GoTo 0
Do While Not rs.EOF
r = r + 1
For f = 0 To rs.Fields.Count - 1
On Error Resume Next
.Cells(r, c + f).Formula = rs.Fields(f).Value
On Error GoTo 0
Next f
rs.MoveNext
Loop
.Rows(TargetCell.Cells(1, 1).Row).Font.Bold = True
.Columns("A:IV").AutoFit
End With
With Application
.StatusBar = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Access - VBA - Cannot import new excel file - but can after opening it once

I'm using some VBA to import an excel file into Access.
Public Sub ImportExcelSpreadsheet(fileName As String, tableName As String)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, tableName, fileName, True, "A5:H5000"
End Sub
And:
Private Sub btnBrowse_Click()
Dim diag As Office.FileDialog
Dim Item As Variant
Set diag = Application.FileDialog(msoFileDialogFilePicker)
diag.AllowMultiSelect = False
diag.Title = "Please select your excel file"
diag.Filters.Clear
diag.Filters.Add "Excel files", "*.xls, *.xlsx"
If diag.Show Then
For Each Item In diag.SelectedItems
Me.txtFileName = Item
Next
End If
End Sub
The problem is as follows:
I extract an excel file from one of the applications we have running here. It's a 97-2003 .xls file.
If I do not open the file in excel first my access app will not import it, throwing a "table is in unexpected format"-error. If I open the excel file once in excel itself and close it (without altering or saving it) access will then accept the file.
I have other 97-2003 excel files exported from other applications which work fine without having to open them once...am at a loss here.
I've tried using acSpreadsheetTypeExcel8 and 9 instead. No luck.
The excel file is also not a .htm in disguise.
Does anyone here have any suggestions?
Can you export from Excel to Access using ADO???
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\FolderName\DataBaseName.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value
.Fields("FieldName2") = Range("B" & r).Value
.Fields("FieldNameN") = Range("C" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Can you do the same using DAO???
Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb")
' open the database
Set rs = db.OpenRecordset("TableName", dbOpenTable)
' get all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value
.Fields("FieldName2") = Range("B" & r).Value
.Fields("FieldNameN") = Range("C" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
Can you import to Access form a closed Workbook???
GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "A1:B21", ActiveCell, False
GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "MyDataRange", Range ("B3"), True
Sub GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, _
TargetRange As Range, IncludeFieldNames As Boolean)
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
' this will return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
' this will return data from any worksheet in SourceFile
' SourceRange must include the range headers
'
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
Dim TargetCell As Range, i As Integer
dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
"ReadOnly=1;DBQ=" & SourceFile
Set dbConnection = New ADODB.Connection
On Error GoTo InvalidInput
dbConnection.Open dbConnectionString ' open the database connection
Set rs = dbConnection.Execute("[" & SourceRange & "]")
Set TargetCell = TargetRange.Cells(1, 1)
If IncludeFieldNames Then
For i = 0 To rs.Fields.Count - 1
TargetCell.Offset(0, i).Formula = rs.Fields(i).Name
Next i
Set TargetCell = TargetCell.Offset(1, 0)
End If
TargetCell.CopyFromRecordset rs
rs.Close
dbConnection.Close ' close the database connection
Set TargetCell = Nothing
Set rs = Nothing
Set dbConnection = Nothing
On Error GoTo 0
Exit Sub
InvalidInput:
MsgBox "The source file or source range is invalid!", _
vbExclamation, "Get data from closed workbook"
End Sub
Finally...can you browse to an Excel file and import data from that file???
Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False
strBrowseMsg = "Select the EXCEL file:"
' Change C:\MyFolder\ to the path for the folder where the Browse
' window is to start (the initial directory). If you want to start in
' ACCESS' default folder, delete C:\MyFolder\ from the code line,
' leaving an empty string as the value being set as the initial
' directory
strInitialDirectory = "C:\MyFolder\"
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
Filter:=strFilter, OpenFile:=False, _
DialogTitle:=strBrowseMsg, _
Flags:=ahtOFN_HIDEREADONLY)
If strPathFile = "" Then
MsgBox "No file was selected.", vbOK, "No Selection"
Exit Sub
End If
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "tablename"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
Try these examples and post back with your findings.

Resources