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]

stabilo wrote:
> 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:\****\"
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

--
**** Kusleika
Excel MVP
Daily Dose of Excel
www.*****-blog.com

[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]

bhellsun wrote:
> 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.

--
**** Kusleika
Excel MVP
Daily Dose of Excel
www.*****-blog.com

[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 rough 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')"

"**** Kusleika" wrote:

> stabilo wrote:
> > 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:\****\"
> 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
>
> --
> **** Kusleika
> Excel MVP
> Daily Dose of Excel
> www.*****-blog.com
>
>
>

[Dick Kusleika]

stabilo wrote:
> 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...

--
**** Kusleika
Excel MVP
Daily Dose of Excel
www.*****-blog.com

[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.

--
**** Kusleika
Excel MVP
Daily Dose of Excel
www.*****-blog.com

bhellsun wrote:
> 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.

[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]

bhellsun wrote:

> 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.

--
**** Kusleika
Excel MVP
Daily Dose of Excel
www.*****-blog.com

[bhellsun]

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..

[Dick Kusleika]

bhellsun wrote:
> 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.


--
**** Kusleika
Excel MVP
Daily Dose of Excel
www.*****-blog.com

[bhellsun]

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("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 CTS guidelines") = Range("S" & r).Value
.Fields("handle the customers request for an escalation 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 escalation appropriately2") = Range("AB" & r).Value
.Fields("Issue Recognition (Empathy/Accountability)2") = Range("AC" & r).Value
.Fields("positioned Help Desk appropriately per CTS 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 escalation appropriately3") = Range("AO" & r).Value
.Fields("Issue Recognition (Empathy/Accountability)3") = Range("AP" & r).Value
.Fields("positioned Help Desk appropriately per CTS 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