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

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.

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

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

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

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

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