Import from workbook cells to access table

[Logsheet pencil pusher]

Hi,

We receive a report in excel twice a year and the information is in non
contiguous cells. I'd like to pull the data from all the workbooks into an
access dbase. here's the cells of the feeder reports.

1-PD 2-PD
D6 G6
D8 G8
d10 G10
D12 G12
D14 G14
D16 G16
D20 G20

I'd like to import it into an access table with column headings from left to
right, one heading for each number. Example D6= employees, D8=sick leave,
D10=vacation. help on pulling data from specific cells oc closed workbooks
would be greatly appreciated!

 

[Ken Snell \(MVP\)]

See this article:
http://www.accessmvp.com/KDSnell/EXCEL_ImpExp.htm#WriteFileRst

 

[Logsheet pencil pusher]

Ken,

Thanks for your help, I am getting a compile error, "invalid outside
proceedure" then VB debug goes to "set" xlx = createObject
("excel.Application")

 

[Ken Snell \(MVP\)]

Are you trying to run the code while you already have EXCEL open? If yes,
change this line:
Set xlx = CreateObject("Excel.Application")

to this:
On Error Resume Next
Dim blnEXCEL As Boolean
blnEXCEL = False
Set xlx = CreateObject("Excel.Application")
If Err.Number <> 0 Then
Set xlx = GetObject(, "Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0


Then, farther down near end of code, change this line:
xlx.Quit

to this:
If blnEXCEL = False Then xlx.Quit

 

[Ken Snell \(MVP\)]

Slight correction to the code (I also have changed the code at my website):

change this line:
Set xlx = CreateObject("Excel.Application")

to this:
On Error Resume Next
Dim blnEXCEL As Boolean
blnEXCEL = False
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


Then, farther down near end of code, change this line:
xlx.Quit

to this:
If blnEXCEL = True Then xlx.Quit


Also, what version of ACCESS and EXCEL are you using?
--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/

 

[Logsheet pencil pusher]

Ken,

I am using access 2002-2003, I am a bit of a newbee at this. Our reporting
system is archaic when compared to automtaion tools available today. So I am
working to bring us into the 21st century. My intent is to put all incoming
reports in one folder, then use the string you gave me to pull the
information into access.

I'm still getting an error message, this time at the blnEXCEL = False. Here
is the entire module:

Option Compare Database

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

blnEXCEL = False

On Error Resume Next
Dim blnEXCEL As Boolean
blnEXCEL = False
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

xlx.Visible = True

' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file from which you will read the data
Set xlw = xlx.Workbooks.Open("w:\arlm\comet\fy09allstatescometreport.xls", ,
True) ' opens in read-only mode

' Replace WorksheetName with the actual name of the worksheet
' in the EXCEL file
Set xls = xlw.Worksheets("")

' Replace A1 with the cell reference from which the first data value
' (non-header information) is to be read
Set xlc = xls.Range("d1") ' this is the first cell that contains data

Set dbs = CurrentDb()

' Replace QueryOrTableName with the real name of the table or query
' that is to receive the data from the worksheet
Set rst = dbs.OpenRecordset("newdata", dbOpenDynaset, dbAppendOnly)

' write data to the recordset
Do While xlc.Value <> ""
rst.AddNew
For lngColumn = 0 To rst.Fields.Count - 1
rst.Fields(lngColumn).Value = xlc.Offset(0, lngColumn).Value
Next lngColumn
rst.Update
Set xlc = xlc.Offset(1, 0)
Loop

rst.Close
Set rst = Nothing

dbs.Close
Set dbs = Nothing

Set xlc = Nothing
Set xls = Nothing
xlw.Close False ' close the EXCEL file without saving any changes
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing

 

[Ken Snell \(MVP\)]

Sorry for the late reply; have been busy traveling.

What error message are you getting on the "blnEXCEL = False" line?

 

[Logsheet pencil pusher]

Hope you'll be home for the holidays!

Sorry, I fogot to include the error. I am getting a compile error, "invalid
outside
proceedure".

 

[Ken Snell \(MVP\)]

Aha, sorry for missing this earlier (been tired).

You do not have a procedure named in the module. Your code starts right out
with the Dim statement.

You need something like this, assuming that you want to call a subroutine
that is your code:



Option Compare Database

Public Sub GoGetMyExcelData()

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

blnEXCEL = False

On Error Resume Next
Dim blnEXCEL As Boolean
blnEXCEL = False
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

xlx.Visible = True

' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file from which you will read the data
Set xlw = xlx.Workbooks.Open("w:\arlm\comet\fy09allstatescometreport.xls", ,
True) ' opens in read-only mode

' Replace WorksheetName with the actual name of the worksheet
' in the EXCEL file
Set xls = xlw.Worksheets("")

' Replace A1 with the cell reference from which the first data value
' (non-header information) is to be read
Set xlc = xls.Range("d1") ' this is the first cell that contains data

Set dbs = CurrentDb()

' Replace QueryOrTableName with the real name of the table or query
' that is to receive the data from the worksheet
Set rst = dbs.OpenRecordset("newdata", dbOpenDynaset, dbAppendOnly)

' write data to the recordset
Do While xlc.Value <> ""
rst.AddNew
For lngColumn = 0 To rst.Fields.Count - 1
rst.Fields(lngColumn).Value = xlc.Offset(0,
lngColumn).Value
Next lngColumn
rst.Update
Set xlc = xlc.Offset(1, 0)
Loop

rst.Close
Set rst = Nothing

dbs.Close
Set dbs = Nothing

Set xlc = Nothing
Set xls = Nothing
xlw.Close False ' close the EXCEL file without saving any changes
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing

End Sub

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/