RE: Manipulating MS Access records with excel VBA + ADO

Here is a trickj to get the SQL statements

1) From work*** go to menu

Data - Import External Data - New Database query

2) Select MS Access
3) Select your Database
4) Select the table and columns you want to manuipulate. Press the arrow to
move items into right box. go to next menu
5) Setup a filter. The menu only allows you 3 items put you can add more
items later in your code. Go to next menu
6) Setup any sort items you want. Go to next menu
7) Select the control button view dataor edit query. Press finish
8) The query editor now will appear. Look for SQL button to get the SQL
statements. You can copy these statements into you VBA editor. I usually
put them into notepad and edit from notepad. You can change the SQL
statements and the editor will give you errors if you typed something wrong.

9) Take the SQL statements and put into a string by adding double quotes.
the SQL editor has multiple rows so add vbCRLF between rows. Something like
this

From SQL editor
Line 1
Line 2
Line 3

Then the string would be

MySQL = "Line 1" & vbcrlf & "Line 2" & vbcrlf & "Line 3"



"David" wrote:

Thanks Joel
I'll work through this and see how I get on with my code

"Joel" wrote:

Here are two examples. The first adds records into a database from excel.
It uses the RS method of adding records. The SOURCE part of the RS is the
SQL. In this case the code is retrieving every record. You can add SELECT,
WHere, and other SQL filters into the code.

The second method is doing a query to retrive the data. the COmmand Text is
the SQL statements.

I could take this portion of the query

.CommandText = Array( _
"SELECT Submissions.Task_ID," & _
"Submissions.`Client Name`," & _
"Submissions.`Effective Date`," & _
"Submissions.`Imp Mgr`," & _
"Submissions.`Due Date`," & _
"Submissions.`Actual Date`," & _
"Submissions.`Date Difference`" & _
Chr(13) & "" & Chr(10) & _
"FROM `C:\temp\submission`.Submissions Submissions")

and change it to this

MySelect = "SELECT Submissions.Task_ID," & _
"Submissions.`Client Name`," & _
"Submissions.`Effective Date`," & _
"Submissions.`Imp Mgr`," & _
"Submissions.`Due Date`," & _
"Submissions.`Actual Date`," & _
"Submissions.`Date Difference`"
MyFrom = "FROM `C:\temp\submission`.Submissions Submissions"
MySQL = MySelect & vbCRLF & MyFrom

Then in the 1st macro

With rs
.Open Source:="Submissions", _

replace with
.open Sourc:=MySQL



Remember to add the references to the VBA menu Tools - References

1) Microsoft Access 11.0 object library (or latest on your PC)
2) Microsoft ActiveX Data Object 2.8 (or latest on your PC)

You have the choice of searching through the database by making a SQL to
filter what you are looking for, or retriving more than wha tyou need and
then looking at each item in the RS to find you particular data like

for each itm in RX
'then add coded here to check each returned item.
next itm


Sub Submit()
'filename of database is with MakeDatabase macro

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

strDB = Folder & FName

If Dir(strDB) = "" Then
MsgBox ("Database Doesn't Exists, Create Database" & strDB)
MsgBox ("Exiting Macro")
Exit Sub
End If

ConnectStr = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Folder & FName & ";" & _
"Mode=Share Deny None;"

cn.Open (ConnectStr)
With rs
.Open Source:="Submissions", _
ActiveConnection:=cn, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable

If .EOF <> True Then
.MoveLast
End If
End With

With Sheets("Internal Project Plan")

ClientName = .Range("B4")
ImpMgr = .Range("B5")
LaunchDate = .Range("C4")

LastRow = .Range("K" & Rows.Count).End(xlUp).Row
For RowCount = 7 To LastRow

If UCase(.Range("K" & RowCount)) = "X" Then

DueDate = .Range("E" & RowCount)
ActualDate = .Range("F" & RowCount)
DateDif = .Range("M" & RowCount)
Accurate = .Range("L" & RowCount)
Task_ID = .Range("B" & RowCount)

With rs
.AddNew
!Task_ID = Task_ID
![Client Name] = ClientName
![Effective Date] = LaunchDate
![Imp Mgr] = ImpMgr
![Due Date] = DueDate
![Actual Date] = ActualDate
![Date Difference] = DateDif

.Update
End With
End If
Next RowCount

End With

Set appAccess = Nothing
End Sub

Public Const Folder = "C:\Temp"
Public Const FName = "submission.mdb"
Sub CreateQuery()
'
' Macro4 Macro
' Macro recorded 1/19/2009 by Joel
'
strDB = Folder & "\" & FName
'
With Active***.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;" & _
"DBQ=" & strDB & ";" & _
"DefaultDir=" & Folder & ";" & _
"DriverId=25;" & _
"FIL=MS Access;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5"), _
Array(";")), Destination:=Range("A1"))

.CommandText = Array( _
"SELECT Submissions.Task_ID," & _
"Submissions.`Client Name`," & _
"Submissions.`Effective Date`," & _
"Submissions.`Imp Mgr`," & _
"Submissions.`Due Date`," & _
"Submissions.`Actual Date`," & _
"Submissions.`Date Difference`" & _
Chr(13) & "" & Chr(10) & _
"FROM `C:\temp\submission`.Submissions Submissions")
.Name = "Query from MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub


"David" wrote:

Anyone got example Excel vba + ADO code to update an access record:

Search an access table primary key field (unique values) for Myvalue
if Myvalue found, read the record into excel vba and process
if required, delete the record from the access table
then, write new updated record to access table
Thanks for your time

.

Loading