VBA code help Export Excel data to Access table

[Mads Petersen]

I'm stuck in this code. Hope you can and will help me. I launch it
from excel.
I have made the following code work, but not as i whant. I need the
ranges to be working with something like xlDown.
eg. this only transferes the first record in the area.
..Fields("Uge").Value = ws.Range("A98").Value
Sub SelectMaster()

Dim db As Database
Dim rs1 As Recordset
Dim ws As Worksheet

Set ws = ActiveSheet
Set db = OpenDatabase("c:\data\BPO\Timereview\TimeReview.md b")

Set rs1 = db.OpenRecordset(Name:="TimeReview", Type:=dbOpenDynaset)
With rs1
..AddNew
..Fields("Uge").Value = ws.Range("A98").Value
..Fields("Manager").Value = ws.Range("B98").Value
..Fields("Medarbejder").Value = ws.Range("C98").Value
..Fields("MA-niv").Value = ws.Range("D98").Value
..Fields("Totaltimer").Value = ws.Range("E98").Value
..Fields("Overtid").Value = ws.Range("F98").Value
..Fields("DirTimer").Value = ws.Range("G98").Value
..Fields("Ferie").Value = ws.Range("H98").Value
..Fields("Helligdage").Value = ws.Range("I98").Value
..Fields("Sygdom").Value = ws.Range("J98").Value
..Fields("Barsel").Value = ws.Range("K98").Value
..Fields("Skole/intern uddannelse").Value = ws.Range("L98").Value
..Fields("Chargeability").Value = ws.Range("M98").Value
..Fields("Efficiency").Value = ws.Range("N98").Value
..Fields("Opsparet overtid").Value = ws.Range("O98").Value

..Update
End With
rs1.Close

'close database
db.Close

'Clean up
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub

[Tom]

One way is below. I was coming at it from Access, not Excel, so you
will need to modify a bit. Its not the most elegant, but it works. My
main problem was that the spreadsheet I was getting the data from
didn't have column names, otherwise I could have just used an insert
query instead of the klunky walk thru the recordset.

Some explaination first...

strFile = the full path and file name of the spreadsheet I was
importing
Input1 was the named area in the spreadsheet I was importing

************************************************** ************************************
Set db = CurrentDb
Set XLTable = db.CreateTableDef("Temp")
XLTable.Connect = "Excel 5.0;HDR=YES;IMEX=2;DATABASE=" & strFile
XLTable.SourceTableName = "Input1"
Input_Table was the table I wanted the data to end up in
db.TableDefs.Append XLTable

sqlstr = "SELECT * FROM Temp;"
Set rstXL = CurrentDb.OpenRecordset(sqlstr, dbOpenSnapshot)
Set rstAcc = CurrentDb.OpenRecordset("Select * from Input_Table",
dbOpenDynaset)

rstXL.MoveFirst
Do Until rstXL.EOF
rstAcc.AddNew
For n = 0 To rstXL.Fields.Count - 1
rstAcc.Fields(n) = rstXL.Fields(n)
Next n
rstAcc.Update
rstXL.MoveNext
Loop
Set rstXL = Nothing
Set rstAcc = Nothing
'Remove the attached table because it's no longer needed.
db.TableDefs.Delete "Temp"

Set db = Nothing
************************************************** *************************

Good luck

[Rich P]

Here is one way to write data from Excel to Access. First, add this
subroutine to a Standard module in your Access mdb. Note: this
subroutine will be pulling data from an Excel file that resides in the
same directory as the mdb and from a sheet called "Sheet1" (Sheet1$ -
will need the $ dollar sign symbol appended to the sheetname). You can
change the location of the excel file and filename and Sheet name. You
can hardcode the location. But to try this example out, create an Excel
file called Book1 and plant it in the same dir as your mdb. Add some
data to Sheet1, preferrably left oriented (means starting on Column A)
and organized (meaning 10 rows will all have 10 columns of data and each
column will have the same data per row, like colA will be text, colB
int, colC dates, colE text, etc).

Sub ConnectToExcel()
Dim DB As Database, tdf As TableDef, strPath As String
Dim strTable As String, strConnect As String
Dim strSourceTable As String

Set DB = CurrentDb
strPath = Left(DB.Name, Len(DB.Name) - Len(Dir(DB.Name)))
strPath = strPath & "Book1.xls"
strConnect = "Excel 5.0;HDR=YES;IMEX=2;DATABASE=" & strPath

For Each tdf In DB.TableDefs
If tdf.Name = "Book1" Then DB.TableDefs.Delete tdf.Name
Next
Set tdf = DB.CreateTableDef("Book1")
tdf.Connect = strConnect
tdf.SourceTableName = "Sheet1$"
DB.TableDefs.Append tdf
DoCmd.RunSql "Select Into YourAccTbl Select * From Book1"
DB.TableDefs.Delete strTable

End Sub

You can invoke this routine straight from Access or from Excel. To
invoke it from Excel, use Comm Automation:

Set a reference to the Microsoft Access Object Library in
Tools/References

Then

Dim accApp As Access.Application
Set accApp = CreateObject("Access.Application")
accApp.OpenCurrentDatabase ("C:\mdb1.mdb")
accApp.Run("ConnectToExcel")
accApp.CloseCurrentDatabase
Set accApp = Nothing

The connectString

"Excel 5.0;HDR=YES;IMEX=2;DATABASE=" & strPath

works with Excel97. For Excel2k or higher might have to change Excel
5.0 to Excel 9.0, 10.0 or it may work fine the way it is.

The "ConnectToExcel" subroutine will link the Excel sheet ("Sheet1$" or
whatever you name your sheet - you have to append $ to the Sheet name)
and then use Sql to retrieve whatever is on Sheet1 and plant it into a
table of your naming. Once the data is in Access it is much easier to
manipulate. It is always easier to parse data on home ground than to
parse it remotely. So you retrieve bulk data from Sheet1 then use
Access code to parse what you need. Much easier this way. Access will
only pick up whatever you put in Sheet1. If you only want to retrieve
10 records from SheetWhatever, then only plant 10 records in that sheet.
That will be your distribution sheet.

Rich

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

[Ronald W. Roberts]

Mads Petersen wrote:

I'm stuck in this code. Hope you can and will help me. I launch it
from excel.
I have made the following code work, but not as i whant. I need the
ranges to be working with something like xlDown.
eg. this only transferes the first record in the area.
.Fields("Uge").Value = ws.Range("A98").Value
Sub SelectMaster()

Dim db As Database
Dim rs1 As Recordset
Dim ws As Worksheet

Set ws = ActiveSheet
Set db = OpenDatabase("c:\data\BPO\Timereview\TimeReview.md b")

Set rs1 = db.OpenRecordset(Name:="TimeReview", Type:=dbOpenDynaset)
With rs1
.AddNew
.Fields("Uge").Value = ws.Range("A98").Value
.Fields("Manager").Value = ws.Range("B98").Value
.Fields("Medarbejder").Value = ws.Range("C98").Value
.Fields("MA-niv").Value = ws.Range("D98").Value
.Fields("Totaltimer").Value = ws.Range("E98").Value
.Fields("Overtid").Value = ws.Range("F98").Value
.Fields("DirTimer").Value = ws.Range("G98").Value
.Fields("Ferie").Value = ws.Range("H98").Value
.Fields("Helligdage").Value = ws.Range("I98").Value
.Fields("Sygdom").Value = ws.Range("J98").Value
.Fields("Barsel").Value = ws.Range("K98").Value
.Fields("Skole/intern uddannelse").Value = ws.Range("L98").Value
.Fields("Chargeability").Value = ws.Range("M98").Value
.Fields("Efficiency").Value = ws.Range("N98").Value
.Fields("Opsparet overtid").Value = ws.Range("O98").Value

.Update
End With
rs1.Close

'close database
db.Close

'Clean up
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub

I haven't worked with VBA in Excell for a while.
This may help to point put you in the right direction.
Also look at Selection.SpecialCells(xlCellTypeLast Cell).Select

In my program I was taking a text file of unknown length from a scanner
application and appending it to existing data in Excel,
then generating a new graph.

This is Air Code.

Dim X as integer
Dim R as integer
R = ActiveSheet.UsedRange.Rows.Count
rs1.AddNew
for X="Some row number" to R 'or maybe R-1 , not sure
rs1.Fields("Uge").Value = ws.Cells("A",X).Value
rs1.Fields("Manager").Value = ws.Cells("B",X).Value
Next X
rs1.Update
Hope this helps.
Ron

--
Ronald W. Roberts
Roberts Communication
rw*@robcom.com