Pull data from Access

Hi All,

I have data about 1200 rows 40 Columns in Access. I need to pull this data in excel using VBA. So the user will just select dropdowns in excel (around 4-5 dropdown) .This would be the criteria based on which data should be pulled..

If its only criteria. I know how to pull data. But help needed when the user will have more than one criteria.


Thanks in advance.


Sujit

Originally Posted by pike

Hi sujitshukla
what code do you have sofar?

Hi,

this is the code i am using

Private Sub CommandButton1_Click()
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim r As Long
con.Open "Provider=Microsoft.Jet.Oledb.4.0; " & _
"data Source=C:\Documents and Settings\Administrator\Desktop\db1.mdb;"
rs.Open "tbl_name", con, adOpenKeyset, adLockOptimistic, adCmdTable
r = 6
Do While Len(Sheet1.Range("A" & r).Formula) > 0
With rs
.AddNew
.Fields("NAME") = Sheet1.Range("B" & r).Value
.Update
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
con.Close
Set con = Nothing



End Sub

Originally Posted by pike

Hi sujitshukla
Can you please add code tags to your script as per the rules and it makes the code easier to read

Hi Pike..

Sorry about that, but do you have a solution for my query. I am still struggling.

Ok...Here it is sir

Private Sub CommandButton1_Click()
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim r As Long
con.Open "Provider=Microsoft.Jet.Oledb.4.0; " & _
"data Source=C:\Documents and Settings\Administrator\Desktop\db1.mdb;"
rs.Open "tbl_name", con, adOpenKeyset, adLockOptimistic, adCmdTable
r = 6
Do While Len(Sheet1.Range("A" & r).Formula) > 0
With rs
.AddNew
.Fields("NAME") = Sheet1.Range("B" & r).Value
.Update
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
con.Close
Set con = Nothing

Now may i get something.

Hi
this is a code I use

'This sub will download the information in the database 
'NOTE the worksheet and the database should be in the same folder.
'Otherwise change the path

Sub ObjectInfo()
   Dim cnt As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim stDB As String, stSQL1 As String
   Dim wsBlad1 As Worksheet
   Dim rSlutetA As Range, rSlutetR As Range 'My first column is A and my last column is R 
   
   Set cnt = New ADODB.Connection
   Set rst = New ADODB.Recordset
   Set wsBlad1 = ThisWorkbook.Worksheets("Name of sheet")

Application.ScreenUpdating = False
   'Path to database Note that the database should be in the same folder as this worksheet
    stDB = ThisWorkbook.Path & "\" & "db1.mdb"
    
    'Shows all elevators - objects
    stSQL1 = "Select * FROM TableName ORDER BY IdInfo"
    
    'Remove old information
   wsBlad1.Range("A1").CurrentRegion.Clear

   'Create connection to database and open sql
   cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & stDB & ";"
    rst.Open stSQL1, cnt

wsBlad1.Select

Set rSlutetA = wsBlad1.Range(Range("A2"), Range("A65536").End(xlUp)) 'Range A2 to the end of column A
Set rSlutetR = wsBlad1.Range(Range("R2"), Range("R65536").End(xlUp)) 'Range R2 to the end of column R

   'Write field name
   
   Range("A1").Value = "Column heading"
   Range("B1").Value = "Column heading "
   Range("C1").Value = "Column heading"
   Range("D1").Value = "Column heading"
  'Add as many columns as you want and you can skip this if you don't need the headings
	
Range("A1:R1").Font.FontStyle = "Bold" 'Makes heading bold
'Information copied to worksheet
   wsBlad1.Cells(2, 1).CopyFromRecordset rst

   'Remove old information, sort and close connection
     wsBlad1.Select
   
   'Sorting descending order in column A
   Range(rSlutetA, rSlutetR).Sort Key1:=Range("B2"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
   cnt.Close
   Set cnt = Nothing
   
ThisWorkbook.Worksheets("Name of sheet").Select
End Sub

You probably have to change it to fit your needs, but I hope it will help you.
Gunilla

Sorry this happens when you don't read the question to the end.
Gunilla

Thanks guys for the code...The code works perfectly fine.
My only query here is .I will provide the user with some options in excel sheet such as data validation.

So he will
Select a Start date in Cell A1 of Excel Sheet1.
Select a End date in Cell A2 of Excel Sheet1.
Select a Location in Cell A3 of Excel Sheet1.

My Query should pull data based on the above.

Logic wise i am clear . Putting this in VBA is kind of difficult for me.

Thanks once again

Hi Friends,

Need help from you all for the below mentioned Query.
When i am trying to extract data in excel from acess, I am getting a "Data Mismatch error". Can you suggest what is causing this.

There are 4 fields in access table Name (text), Date (date/time), Locatin(text) and Sr No.

Sub testcon()
Dim conn As ADODB.Connection
Dim rec As ADODB.Recordset
Dim path As String
Dim strsql As String
Dim wks As Worksheet
Dim startdate As String, enddate As String

Set conn = New ADODB.Connection
Set rec = New ADODB.Recordset
Set wks = ThisWorkbook.Worksheets("Sheet1")
path = ThisWorkbook.path & "\" & "db1.mdb"

wks.Range("A2:E800").ClearContents



'strsql = "Select * from cust_tbl"

strsql = "SELECT * FROM cust_tbl where Date>='" & wks.Range("f2") & "' and Date<='" & wks.Range("g2") & "' and Locatin = """ & wks.Range("h2") & """;"

conn.Open "Provider=Microsoft.Jet.Oledb.4.0; " & "Data Source =" & path & ";"

rec.Open strsql, conn
Sheet1.Select

wks.Cells(2, 1).CopyFromRecordset rec

conn.Close
Set conn = Nothing


End Sub

Your help much appreciated.

Hi Tony,

Thanks for the prompt response. First thing is i am new to VBA . When i execute the query doing F8, the Select statement gets executed. the next line where i open the recordset i get an error there. I checked the format of cells in access and excel and it is the same. date format for date and text format for location.

Sujit