HELP: get a block of data to access by clicking a button in excel

[sam]

Hi All,

How can I make a block of data from excel go in access by clicking a
"Submit" button?

eg: There is a "Submit" button on the excel sheet that exports all of the
student data at once in the access database.. I want to insert all this data
in a
seperate row.. all at once..

Here is what My excel table looks like:

Student_ID Subjects Grades
123456 Eng A
123456 Hist B
123456 Math B+
123456 Bio B-

So, once we click "Submit" I want the data displayed above to go to
access, I know how to transfer data from excel to access by click of a
button, BUT I dont know how to get a block of data from excel go to access at
the same time.

Thanks in advance

 

[Mike]

Sam,
What are you meaning by a block of data? Are you meaning all your records at
the same time ? If you are i dont no if you can. But uploading all 65536 rows
in a 2003 worksheet to access does not really take that muck time to do. Why
are you wanting to do the whole block ?

 

[joel]

Here are two macros that I wrote to create a datebase and upload dat
from a worksheet to Access.

YOu need to add two references into excel VBA for these to work. Fro
VBA menu - Tools - References


1) Microsoft Access 11.0 object Library (or latest version on your PC)
2) Microsoft ActiveX Data objects 2.8 library (or Latest version on yo
PC)




Public Const Folder = "C:\Temp\"
Public Const FName = "submission.mdb"
Sub MakeDataBase()

Const DB_Text As Long = 10
Const FldLen As Integer = 40


strDB = Folder & FName

If Dir(strDB) <> "" Then
MsgBox ("Database Exists - Exit Macro : " & strDB)
Exit Sub
End If

' Create new instance of Microsoft Access.
Set appAccess = CreateObject("Access.Application")
appAccess.Visible = True


' Open database in Microsoft Access window.
appAccess.NewCurrentDatabase strDB
' Get Database object variable.
Set dbs = appAccess.CurrentDb
' Create new table.
Set tdf = dbs.CreateTableDef("Submissions")

' Create Task/ID field in new table.
Set fld = tdf. _
CreateField("Task_ID", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Client Name field in new table.
Set fld = tdf. _
CreateField("Client Name", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Effective Date field in new table.
Set fld = tdf. _
CreateField("Effective Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Imp Mgr field in new table.
Set fld = tdf. _
CreateField("Imp Mgr", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Due Date field in new table.
Set fld = tdf. _
CreateField("Due Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Actual Date field in new table.
Set fld = tdf. _
CreateField("Actual Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Date Difference field in new table.
Set fld = tdf. _
CreateField("Date Difference", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

dbs.TableDefs.Append tdf

Set appAccess = Nothing


End Sub

Sub Submit()
'filename of database is with MakeDatabase macro

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

strDB = Folder & FName

If Dir(strDB) = "" Then
MsgBox ("Database Doesn't Exists, Create Database" & strDB)
MsgBox ("Exiting Macro")
Exit Sub
End If

ConnectStr = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Folder & FName & ";" & _
"Mode=Share Deny None;"

cn.Open (ConnectStr)
With rs
.Open Source:="Submissions", _
ActiveConnection:=cn, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable

If .EOF <> True Then
.MoveLast
End If
End With

With Sheets("Internal Project Plan")

ClientName = .Range("B4")
ImpMgr = .Range("B5")
LaunchDate = .Range("C4")

LastRow = .Range("K" & Rows.Count).End(xlUp).Row
For RowCount = 7 To LastRow

If UCase(.Range("K" & RowCount)) = "X" Then

DueDate = .Range("E" & RowCount)
ActualDate = .Range("F" & RowCount)
DateDif = .Range("M" & RowCount)
Accurate = .Range("L" & RowCount)
Task_ID = .Range("B" & RowCount)

With rs
.AddNew
!Task_ID = Task_ID
![Client Name] = ClientName
![Effective Date] = LaunchDate
![Imp Mgr] = ImpMgr
![Due Date] = DueDate
![Actual Date] = ActualDate
![Date Difference] = DateDif

.Update
End With
End If
Next RowCount

End With

Set appAccess = Nothing
End Su

 

[sam]

Thanks for helping Mike,

By block I mean a defined range.. Lets say A1:A5, B1:B5, C1:C5, D15..
somethign like this.

this is how the process is designed.. I work on one student and his subjects
and his grades and once I am done with the student clicking a button should
get all his data into access database.

 

[Mike]

Then this will work for you with a few changes
Option Explicit
Private Sub saveDataToAccess()
'Needs reference the Axtive X Library 2.0 or higher
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSQL As String, strConn
Dim r As Integer
r = 6
'access database 2003 or less
'C:\PathToYourStudentMdb\Student.mdb (Change)
strConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" _
& "C:\PathToYourStudentMdb\Student.mdb;Persist Security Info=False"

'access database 2007 (Ace No Security)
'strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& "C:\PathToYourStudentaccdb\myAccess2007file.accdb;Persist Security
Info=False;"

'access database 2007 (Ace With Security)
'strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& "C:\PathToYourStudentaccdb\myAccess2007file.accdb;Jet OLEDBatabase
Password=MyDbPassword;"

'sSQL = Name Of Your Access table Change to your
'Table Name
sSQL = "TableName"

Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
cnn.Open strConn

rs.Open sSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTable
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("Field1") = Range("A" & r).Value
.Fields("Field2") = Range("E" & r).Value
.Fields("Field3") = Range("F" & r).Value
.Fields("Field4") = Range("G" & r).Value

' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
cnn.Close
End Sub

 

[sam]

THanks mike,

Will try it now.. One question I had was, Why are you initializing r = 6?

 

[sam]

Hey Mike,

Is your code finding the next empty row in excel? I want to populate into
access from excel so is there a way to do the same in access?

Thanks in advance

 

[Mike]

Change r to = the starting row of your data.

THanks mike,

Will try it now.. One question I had was, Why are you initializing r = 6?