Pulling data from Access

[Pam W.]

First, I want to say how valuable this website is. I've gotten so much help
finding information from other posts.

I've used all this valuable information to create macros that have dazzled
my boss. Now, I'm afraid they think I can do anything. LOL. Let me know if
I'm in over my head--or how far over my head. (I am not familiar with
Access) They want to have an Access database and be able to query data using
Excel. Then they want to pull certain fields from one of the records chosen
by the user into an Excel worksheet. Once it's in this worksheet, it will
have other data added to various column. Then they want to be able to save
that record as a new record in the Access database.

 

[FSt1]

hi
if all you are doing is adding records, it would be far, far easier to enter
the data in access directly. reason is that the input form and the data would
be contained in the same database. excel and access do work well togeather
but for input, i think it would be better to use access as input then use
excel to extract reports via microsoft query.
on the menu bar....
tools>import external data>new database query

my thoughts
Regards
FSt1

 

[Mike]

Private Sub getDataFromAccess()
'Need to add reference to the
'Microsoft Active X Data Objects 2.0 or Higher
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSQL As String, strConn
Dim rowNumber As Long

'C:\PathToYourMdb\Ilsa.mdb (Change)
strConn = "Provider=Microsoft.Jet.OLEDB.4.0; " _
& "Data Source=C:\PathToYourMdb\Ilsa.mdb;Persist Security
Info=False"
'sSQL = "Replace with your query"
sSQL = "SELECT Field1, Field2 From TableName"

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

cnn.Open strConn
rs.Open sSQL, cnn, adOpenStatic, adLockOptimistic
rowNumber = 2 'Starting Row Number for data
Do While (Not rs.EOF)
Range("A" & rowNumber) = rs.Fields("Field1").Value
Range("B" & rowNumber) = rs.Fields("Field2").Value
rowNumber = rowNumber + 1
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
End Sub

 

[Mike]

'Need to add reference to the
'Microsoft Active X Data Objects 2.0 or Higher
Private Sub saveDataToAccess()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSQL As String, strConn
Dim r As Integer
r = 6
'Use for Access (jet)
'Assumes that the access database is in the same folder as thisworkbook
strConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" _
& ThisWorkbook.Path & "\NameOfYourmdb.mdb;Persist Security Info=False"

'Use for jet
'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

 

[pam]

Thank you. I had to seek help from a programmer. He said your code was for
network files. Part of the code he gave me looks like this which works well
for querying an access table.

Dim db As Database
Dim rs As Recordset
Dim col As Integer
Dim row As Integer
Dim sCol As String
Dim query As QueryDef
Dim sQuery As String

' Open the database
Set db = OpenDatabase(sDatabase)

' Prepare to read from the database
sQuery = "SELECT * FROM " & "`" & sTable & "`"
If Len(sWHERE) > 0 Then
sQuery = sQuery & " WHERE " & sWHERE
End If
Set query = db.CreateQueryDef("", sQuery)

' Get the records
Set rs = query.OpenRecordset(dbOpenSnapshot)

' Traverse all records
row = rowField + 1
If Not rs.BOF Then
rs.MoveFirst
End If
Do While Not rs.EOF
'Transfer data into Excel
col = 0
sCol = Chr(Asc("A") + col)
Do While Len(Range(sCol & rowField).Formula) > 0
sTemp = rs.Fields(Range(sCol & rowField).Value)
Range(sCol & row).Value = rs.Fields(Range(sCol & rowField).Value)
col = col + 1
sCol = Chr(Asc("A") + col)
Loop

' Get Next Record
rs.MoveNext
row = row + 1
Loop

' Release resources
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing