create a mdb databse and a table and add records from Excel VBA

[stabilo]

I need to createa new database called db.mdb that will contains a table call
tb with a few fields (field1, field2, field3).
Then, I need to be able to add records in this table. Later in my program, I
need to run an SQL query that will returns all records if field1 is = to "X"
(then I need to list the resulting data)
I have many topics about my questions but never managed to make it work.

I have used the following example to create the database :

strDB = "D:\db.mbd" ' Create new instance of Microsoft Access.
Set appaccess = CreateObject("Access.Application")
appaccess.NewCurrentDatabase strDB
Set dbprinter = appaccess.CurrentDb
Set tbprinter = dbprinter.CreateTableDef("tb")

With tbprinter
.Fields.Append .CreateField("filed1", DB_Text)
.Fields.Append .CreateField("filed2", DB_Text)
.Fields.Append .CreateField("filed3", DB_Text)
End With
db.TableDefs.Append tb
db.Close

The database and the table is created fine, but how do I creates records and
then run my queries (the information to fill the querry is coming from a list
from LDAP) ? is there another better method to create the database and the
table (I'm under Excel2003, XP)

 

[Dick Kusleika]

I need to createa new database called db.mdb that will contains a
table call tb with a few fields (field1, field2, field3).
Then, I need to be able to add records in this table. Later in my
program, I need to run an SQL query that will returns all records if
field1 is = to "X" (then I need to list the resulting data)
I have many topics about my questions but never managed to make it
work.

I don't use Access.Application to create dbs and tables. I use ADOX to
create the tables, then use ADO to create tables, add records, and retrieve
records. You need to set a reference to both the Active X Data Object
library and the ADO Ext. library. Here's an example of how to do that
stuff:

Sub MakeDatabase()

Dim axCat As ADOX.Catalog
Dim adCn As ADODB.Connection
Dim adRs As ADODB.Recordset
Dim sConn As String
Dim sqlInsert As String
Dim sqlFieldX As String
Dim sqlCreate As String
Dim sPath As String
Dim sName As String
Dim sMsg As String

sPath = "C:\Dick\"
sName = "db.mdb"

'create new database
Set axCat = New ADOX.Catalog
axCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=4;Data Source=" & sPath & sName

Set axCat = Nothing

'connect to datatbase
sConn = "DSN=MS Access 97 Database;"
sConn = sConn & "DBQ=" & sPath & sName & ";"
sConn = sConn & "DefaultDir=" & sPath & ";DriverId=281;"
sConn = sConn & "FIL=MS Access;MaxBufferSize=2048"

Set adCn = New ADODB.Connection
adCn.Open sConn

'Create a table
sqlCreate = "CREATE TABLE tb (field1 char(50), field2 char(50), field3
char(50))"

adCn.Execute sqlCreate

'add two records
sqlInsert = "INSERT INTO tb (field1, field2, field3) VALUES ('X', 'Y',
'Z')"
adCn.Execute sqlInsert

sqlInsert = "INSERT INTO tb (field1, field2, field3) VALUES ('A', 'B',
'C')"
adCn.Execute sqlInsert

'Retrieve records with X
sqlFieldX = "SELECT * FROM tb WHERE field1='X'"

Set adRs = New ADODB.Recordset
adRs.Open sqlFieldX, adCn

'dispaly the records in a message box
Do Until adRs.EOF
sMsg = sMsg & adRs.Fields(0).Value & vbTab & _
adRs.Fields(1).Value & vbTab & _
adRs.Fields(2).Value & vbNewLine

adRs.MoveNext
Loop

MsgBox sMsg

adRs.Close
adCn.Close

End Sub

 

[bhellsun]

Hi

I have created a database which has 9 tables. In the same way I have an
excel sheet which has 9 sheets. Exporting from excel to access works
fine using VBA. But my problem is i need to write this code in each and
every sheet. And I have used 9 buttons in excel to upload the data in to
the database.
This is the code I used in VBA.

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


IS THERE A WAY WHERE I CAN UPDATE THE COMPLETE 9 SHEETS TO THE
RESPECTIVE TABLES IN ACCESS IN A SINGLE CLICK.

 

[Dick Kusleika]

I have created a database which has 9 tables. In the same way I have
an excel sheet which has 9 sheets. Exporting from excel to access
works fine using VBA. But my problem is i need to write this code in
each and every sheet. And I have used 9 buttons in excel to upload
the data in to the database.
This is the code I used in VBA.

IS THERE A WAY WHERE I CAN UPDATE THE COMPLETE 9 SHEETS TO THE
RESPECTIVE TABLES IN ACCESS IN A SINGLE CLICK.

No need to shout, I'm right here. Are all of your sheets set up the same?
What is the relationship between the sheet's names and the table's names?
Basically, you loop through all the sheets and inside the loop you add the
records. If your sheet names are the same as your table names, you can
substitute the sheet name for the table name in your sql statement. If not,
you may want an array that holds that info.

 

[bhellsun]

Thanks for the reply.
How do I loop through all the sheets ??
Yes your right there is a relation between the sheets and the tables
The name of the table is the same as the sheet.
And I have 9 different sheets and corresponding tables.
Can you give me a rought idea about the code

 

[stabilo]

Thank you so much for your answer. I have a couple of question regardings
your example :

1)
This line adds fields with the Text type. What would be the correct syntax
for booleans (yes/no) and integer fields ?
sqlCreate = "CREATE TABLE tb (field1 char(50), field2 char(50), field3

2)
How do you insert values from variables or other objects values ?
sqlInsert = "INSERT INTO tb (field1, field2, field3) VALUES ('X', 'Y',
'Z')"

 

[Dick Kusleika]

Thank you so much for your answer. I have a couple of question
regardings your example :

1)
This line adds fields with the Text type. What would be the correct
syntax for booleans (yes/no) and integer fields ?
sqlCreate = "CREATE TABLE tb (field1 char(50), field2 char(50), field3
http://www.pcreview.co.uk/forums/thread-1163197.php


2)
How do you insert values from variables or other objects values ?
sqlInsert = "INSERT INTO tb (field1, field2, field3) VALUES ('X',
'Y', 'Z')"

Dim var1, var2, var3

sqlInsert = "INSERT INTO tb (field1, field2, field3) VALUES ('" & var1 & "',
'" & var2 & "', '" & var3 & "')"

After VALUES, it reads: Open paren, single quote, double quote, ampersand,
variable, ampersand, double quote, single quote, comma, etc...

 

[Dick Kusleika]

Dim sh As Worksheet
Dim sSql as String

'Your existing connection code, but the rs.Open will go in the loop

For Each sh In ThisWorkbook.Worksheets

sSql = "SELECT * FROM " & sh.Name
rs.Open sSql, cn

r=3
Do While Not IsEmpty(sh.Range("A" & r))
With rs
'Your existing code for AddNew and Update
End With
Loop

rs.Close
Set rs = Nothing
Next sh

That's the rough skeleton. Post back if you need some details.

 

[bhellsun]

Thanks a lot for ur reply but again i guess there is a problem..


Private Sub CommandButton1_Click()

'Sub BNGCTS()
' 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, sh As Worksheet

Set db =
OpenDatabase("\\blrdsbgl401\blr_lcd_qmt$\QMT\Buffer\db1.mdb")
' open the database

For Each sh In ThisWorkbook.Worksheets


Set rs = db.OpenRecordset("sh", dbOpenTable)

' get all records in a table
r = 3 ' the start row in the worksheet

Do While Not IsEmpty(sh.Range("A" & r))

' repeat until first empty cell in column A
With rs

"Adding the records to the database"

End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
Next sh
db.Close
Set db = Nothing
'End Sub


End Sub

Just check the above code....
I guess this is right, but the problem is in each and every sheet the
fields are different. And so I cant put it in a loop. And other way.
Can we create a subroutines for this....and call them inside the
loop...if Yes please give the skeleton again...

 

[Dick Kusleika]

Just check the above code....
I guess this is right, but the problem is in each and every sheet the
fields are different. And so I cant put it in a loop. And other way.
Can we create a subroutines for this....and call them inside the
loop...if Yes please give the skeleton again...

If the fields are all different, it doesn't make any sense to do it in a
loop. Loops are for doing the same thing over and over, not different
things. You just need to go through each sheet one at a time.

rs.Open "SELECT * FROM Table1", Conn
With rs
'AddNew fields
End With
rs.Close

rs.Open "SELECT * FROM Table2", Conn
With rs
'AddNew fields
End With
rs.Close

and so on.

 

[bhellsun]

Accoring to your VBA code, I am able to open the database. But I a
updating from the excel sheet. The actual problem is its updating th
same data from sheet1 to all the tables in the databse. And so th
actual data from sheet2 is not getting updated to the correspondin
tables in the database. Instead only the sheet1 data is getting update
in all the tables. Hence I need to know the code in VBA for sheet2 to b
active and the operatiion has to happen from sheet 2.
I tried sheet.activate, with sheet2...no go...do u want the complet
code of mine.

 

[Dick Kusleika]

Accoring to your VBA code, I am able to open the database. But I am
updating from the excel sheet. The actual problem is its updating the
same data from sheet1 to all the tables in the databse. And so the
actual data from sheet2 is not getting updated to the corresponding
tables in the database. Instead only the sheet1 data is getting
updated in all the tables. Hence I need to know the code in VBA for
sheet2 to be active and the operatiion has to happen from sheet 2.
I tried sheet.activate, with sheet2...no go...do u want the complete
code of mine..

Yes, post the code you have.

 

[bhellsun]

Private Sub CommandButton1_Click()

'Sub BNGCTS()
' exports data from the active worksheet to a table in an Acces
database
' this procedure must be edited before use

Dim db As Database, rs As Recordset, r As Long, sh As Worksheet

Set db
OpenDatabase("\\blrdsbgl401\blr_lcd_qmt$\QMT\Buffer\db1.mdb")
' open the database

'For Each sh In ThisWorkbook.Worksheets


Set rs = db.OpenRecordset("BNG-CTS", 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("Created Date") = Range("A" & r).Value
.Fields("Title") = Range("B" & r).Value
.Fields("Evaluator") = Range("C" & r).Value
.Fields("Member Code") = Range("D" & r).Value
.Fields("Agent") = Range("E" & r).Value
.Fields("TM") = Range("F" & r).Value
.Fields("AM") = Range("G" & r).Value
.Fields("Combo Compliance email") = Range("H" & r).Value
.Fields("CE Combo HeatCheck") = Range("I" & r).Value
.Fields("CE Combo Esurvey") = Range("J" & r).Value
.Fields("Issue Recognition (Empathy/Accountability)")
Range("K" & r).Value
.Fields("reviewed historical information") = Range("L"
r).Value
.Fields("effectively used DSN prior to dispatching parts"
= Range("M" & r).Value
.Fields("issue within support boundaries") = Range("N"
r).Value
.Fields("followed support boundary policy & procedures")
Range("O" & r).Value
.Fields("Con_TS_R1_Within_Boundaries_R") = Range("P"
r).Value
.Fields("Con_TS_R1_Boundaries_PnP_R") = Range("Q"
r).Value
.Fields("Con_TS_R1_Position_HlpDsk_R") = Range("R"
r).Value
.Fields("positioned Help Desk appropriately per CT
guidelines") = Range("S" & r).Value
.Fields("handle the customers request for an escalatio
appropriately") = Range("T" & r).Value
.Fields("Resolution Communication") = Range("U" & r).Value
.Fields("Provided resolution") = Range("V" & r).Value
.Fields("proactive measures to avoid customer callbacks")
Range("W" & r).Value
.Fields("On escalated issues") = Range("X" & r).Value
.Fields("followed support boundary policy & procedures2")
Range("Y" & r).Value
.Fields("Con_TS_R2_Boundaries_PnP_R") = Range("Z"
r).Value
.Fields("effectively used DSN prior to dispatching parts2"
= Range("AA" & r).Value
.Fields("handle the customers request for an escalatio
appropriately2") = Range("AB" & r).Value
.Fields("Issue Recognition (Empathy/Accountability)2")
Range("AC" & r).Value
.Fields("positioned Help Desk appropriately per CT
guidelines2") = Range("AD" & r).Value
.Fields("Con_TS_R2_Position_HlpDsk_R") = Range("AE"
r).Value
.Fields("Provided resolution2") = Range("AF" & r).Value
.Fields("Resolution Communication2") = Range("AG"
r).Value
.Fields("On escalated issues2") = Range("AH" & r).Value
.Fields("reviewed historical information2") = Range("AI"
r).Value
.Fields("issue within support boundaries2") = Range("AJ"
r).Value
.Fields("Con_TS_R2_Within_Boundaries_R") = Range("AK"
r).Value
.Fields("followed support boundary policy & procedures3")
Range("AL" & r).Value
.Fields("Con_TS_R3_Boundaries_PnP_R") = Range("AM"
r).Value
.Fields("effectively used DSN prior to dispatching parts3"
= Range("AN" & r).Value
.Fields("handle the customers request for an escalatio
appropriately3") = Range("AO" & r).Value
.Fields("Issue Recognition (Empathy/Accountability)3")
Range("AP" & r).Value
.Fields("positioned Help Desk appropriately per CT
guidelines3") = Range("AQ" & r).Value
.Fields("Con_TS_R3_Position_HlpDsk_R") = Range("AR"
r).Value
.Fields("Provided resolution3") = Range("AS" & r).Value
.Fields("Resolution Communication3") = Range("AT"
r).Value
.Fields("On escalated issues3") = Range("AU" & r).Value
.Fields("reviewed historical information3") = Range("AV"
r).Value
.Fields("issue within support boundaries3") = Range("AW"
r).Value
.Fields("Con_TS_R3_Within_Boundaries_R") = Range("AX"
r).Value
.Fields("Rep properly open the call") = Range("AY"
r).Value
.Fields("ask for and update the customers email address")
Range("AZ" & r).Value
.Fields("follow appropriate dispatch procedures") =
Range("BA" & r).Value
.Fields("follow the Case Ownership process (when
appropriate)") = Range("BB" & r).Value
.Fields("fulfilled committed callback") = Range("BC" &
r).Value
.Fields("rep properly close the call") = Range("BD" &
r).Value
.Fields("log the call completely and accurately") =
Range("BE" & r).Value
.Fields("Con_TS_B_Logging_R") = Range("BF" & r).Value
.Fields("Con_TS_B_Email_R") = Range("BG" & r).Value
.Fields("call accurately profiled") = Range("BH" &
r).Value
.Fields("technician transfer appropriately") = Range("BI" &
r).Value
.Fields("Rate of Speech") = Range("BJ" & r).Value
.Fields("Sentence Structure/Grammar") = Range("BK" &
r).Value
.Fields("Word Choice/Jargon") = Range("BL" & r).Value
.Fields("Active Listening") = Range("BM" & r).Value
.Fields("Hold & Dead Air") = Range("BN" & r).Value
.Fields("Call Control (Flow)") = Range("BO" & r).Value
.Fields("Professionalism") = Range("BP" & r).Value
.Fields("appropriately addresses terms and conditions of
sale") = Range("BQ" & r).Value
.Fields("address Export Compliance issues completely and
accurately") = Range("BR" & r).Value
.Fields("protects customer account privacy policy") =
Range("BS" & r).Value
.Fields("Customer verification completed") = Range("BT" &
r).Value
.Fields("Con_TS_P_T&C_R") = Range("BU" & r).Value
.Fields("Con_TS_P_Export_Compl_R") = Range("BV" & r).Value
.Fields("Con_TS_P_Privacy_Policy_R") = Range("BW" &
r).Value
.Fields("Con_TS_P_Cust_Verification_R") = Range("BX" &
r).Value
.Fields("CE Policy requirements") = Range("BY" & r).Value
.Fields("Qscore") = Range("BZ" & r).Value
.Fields("Segment") = Range("CA" & 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