write data to access

[Billy]

Hi,

When I come back to work today, I saw your replay. I am so happy that you
can help me.

Here's the code.

Sub t3()
'

'
Range("a2").Select

With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=MS Access
Database;DBQ=C:\db2.mdb;DefaultDir=C:;DriverId=25;FIL=MS
Access;MaxBufferSize=2048;PageTimeout=5;" _
, Destination:=Workbooks("test1.xls").Sheets("Sheet1").Range("B6"))
.CommandText = Array( _
"SELECT Sheet1.ID, Sheet1.`PR NUMBER`, Sheet1.DATE, Sheet1.`Number
1`, Sheet1.`Time Spend`" & Chr(13) & "" & Chr(10) & "FROM `C:\db2`.Sheet1
Sheet1" & Chr(13) & "" & Chr(10) & "WHERE (Sheet1.`PR NUMBER`=3.0)" _
)
.Name = "ExternalData_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub


Regards,

Billy

----- Original Message -----
From: "onedaywhen" <[email protected]>
Newsgroups: microsoft.public.excel.programming
Sent: Friday, November 28, 2003 12:48 AM
Subject: Re: Write data to access file through EXCEL

 

[Tom Ogilvy]

Maybe you want to use a different approach:

http://www.erlandsendata.no/english/vba/adodao/

 

[onedaywhen]

Here's some code that uses this different approach i.e. ADO in VBA
code.

Sub t4 is pretty straightforward. It creates a disconnected recordset,
copies the contents to the workbook and saves the recordset to disk
for later use.

It's difficult to generalize how you want to handle updating the
database. Sub t5 is a suggestion of something you might want to do
i.e. identify a row on the worksheet and use a key column to filter
the recordset, change the corresponding row, reconnect and issue and
update.

If you need further help, post back with more details of what you want
to achieve.

' <code>------------------------------------
' Requires reference to the following:
' Microsoft ActiveX Data Objects 2.n Library

Option Explicit

Private Const strRS_FILENAME As String = "C:\myRs"

Sub t4()

Dim oRS As ADODB.Recordset
Dim strSql As String
Dim oDestination As Excel.Range
Dim lngCounter As Long
Dim lngCols As Long

strSql = "SELECT ID, [PR NUMBER], DATE, [Number 1], [Time Spend]" & _
" FROM Sheet1 WHERE [PR NUMBER]=3"

Set oRS = New ADODB.Recordset

With oRS
.CursorLocation = adUseClient ' 3
.CursorType = adOpenStatic ' 3
.LockType = adLockBatchOptimistic ' 4
.ActiveConnection = GetOpenConnection
.Source = strSql
.Open
.ActiveConnection = Nothing
lngCols = .Fields.Count

End With

Set oDestination = Workbooks("test1.xls").Sheets("Sheet1").Range("B6")

With oDestination

For lngCounter = 0 To lngCols - 1
.Cells(, lngCounter + 1).Value = oRS.Fields(lngCounter).Name
Next

.Cells(2).CopyFromRecordset oRS

.Resize(, lngCols).EntireColumn.AutoFit

End With

With oRS
On Error Resume Next
Kill strRS_FILENAME
On Error GoTo 0
.Save strRS_FILENAME
.Close
End With

End Sub

Private Function GetOpenConnection() As ADODB.Connection

Dim oCon As ADODB.Connection

Const strCONNECT As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\db2.mdb;"

Set oCon = New ADODB.Connection

oCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\db2.mdb;"


Set GetOpenConnection = oCon

End Function

Sub t5()

' Update data source with changes to row B7:F7
' using first column (ID) as key

Dim oRS As ADODB.Recordset
Dim oSource As Excel.Range
Dim vntKeyValue As Variant
Dim lngCols As Long
Dim lngCounter As Long

Set oRS = New ADODB.Recordset

With oRS
.Open strRS_FILENAME
lngCols = .Fields.Count

Set oSource = Workbooks("test1.xls").Sheets("Sheet1").Range("B6")

vntKeyValue = oSource(2, 1).Value

.Filter = "ID=" & CStr(vntKeyValue)

If .EOF Then

.Close
Exit Sub

End If

For lngCounter = 1 To lngCols - 1

.Fields(lngCounter).Value = oSource(2, lngCounter + 1).Value

Next

.ActiveConnection = GetOpenConnection()
.UpdateBatch
.ActiveConnection = Nothing
.Close

End With

End Sub
' </code>------------------------------------

--

 

[onedaywhen]

Here's some example code which uses this different approach.

Sub t4 is fairly straightforward. It creates a recordset based on your
query, copies the data to the target worksheet and saves the recordset
to disk for later use.

Updating the MS Access database based on changes is harder to
generalize. Sub T4 is an example of something you might want to do. It
update the recordset based on the first row of data In Excel, using ID
as a key, and uses the recordset to update the database.

Post back with more details if you need further help.

'<code>-------------------------
Option Explicit

Private Const strRS_FILENAME As String = "C:\myRs"

Sub t4()

Dim oRS As ADODB.Recordset
Dim strSql As String
Dim oDestination As Excel.Range
Dim lngCounter As Long
Dim lngCols As Long

strSql = "SELECT ID, [PR NUMBER], DATE, [Number 1], [Time Spend]" & _
" FROM Sheet1 WHERE [PR NUMBER]=3"

Set oRS = New ADODB.Recordset

With oRS
.CursorLocation = adUseClient ' 3
.CursorType = adOpenStatic ' 3
.LockType = adLockBatchOptimistic ' 4
.ActiveConnection = GetOpenConnection
.Source = strSql
.Open
.ActiveConnection = Nothing
lngCols = .Fields.Count

End With

Set oDestination = Workbooks("test1.xls").Sheets("Sheet1").Range("B6")

With oDestination

For lngCounter = 0 To lngCols - 1
.Cells(, lngCounter + 1).Value = oRS.Fields(lngCounter).Name
Next

.Cells(2).CopyFromRecordset oRS

.Resize(, lngCols).EntireColumn.AutoFit

End With

With oRS
On Error Resume Next
Kill strRS_FILENAME
On Error GoTo 0
.Save strRS_FILENAME
.Close
End With

End Sub

Private Function GetOpenConnection() As ADODB.Connection

Dim oCon As ADODB.Connection

Const strCONNECT As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\db2.mdb;"

Set oCon = New ADODB.Connection

oCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\db2.mdb;"


Set GetOpenConnection = oCon

End Function

Sub t5()

' Update data source with changes to row B7:F7
' using first column (ID) as key

Dim oRS As ADODB.Recordset
Dim oSource As Excel.Range
Dim vntKeyValue As Variant
Dim lngCols As Long
Dim lngCounter As Long

Set oRS = New ADODB.Recordset

With oRS
.Open strRS_FILENAME
lngCols = .Fields.Count

Set oSource = Workbooks("test1.xls").Sheets("Sheet1").Range("B6")

vntKeyValue = oSource(2, 1).Value

.Filter = "ID=" & CStr(vntKeyValue)

If .EOF Then

.Close
Exit Sub

End If

For lngCounter = 1 To lngCols - 1

.Fields(lngCounter).Value = oSource(2, lngCounter + 1).Value

Next

.ActiveConnection = GetOpenConnection()
.UpdateBatch
.ActiveConnection = Nothing
.Close

End With

End Sub
'</code>-------------------------

--