Read/Write data to a closed workbook?

R

razzandy

Active Member
Joined
Jun 26, 2002
Messages
400
Office Version
  1. 2007
Platform
  1. Windows
I've found the below code which I think is inteded for microsoft visual studio. What I'm wondering is can it be changed to work from XL. If so I will be useing one workbook with the code and a userform to read/write data to the closed workbook as a database!

Sub Link()

Dim adoCn
Dim adoRs

Set adoCn = CreateObject("ADODB.Connection")
With adoCn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = _
"Data Source=C:\Island.xls;" & _
"Extended Properties=Excell 8.0;"
End With

Set adoRs = CreateObject("ADODB.Recordset")
strQuery = "SELECT * FROM [Sheet2$]"
With adoRs
Set .ActiveConnection = adoCn
.Open strQuery
End With
End Sub

I've already seen the examples which open one workbook and copy the data over but you may as well just include the data in the original workbook!

Thanks in advance

Ryan A UK :-?
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
Hi Andrew Poulsom

Thanks for the link it's a cracking site! There just one problem I still cant get my code or any code from the website link to work! :oops:

Have you got any examples that work? Is so can you e-mail me a copy?

I think it's something to do with that ADO, do I need to install something?

Thanks for your help :D

Ryan A Uk :o
 
Upvote 0
Hi Andrew

Below is the code from the web link you gave me described as: Use a closed workbook as a database (DAO) @ http://www.erlandsendata.no/english...End Sub [u][/u] Many Thanks Ryan A UK :D
 
Upvote 0
As it says at the bottom of the sample code:

The macro examples assumes that your VBA project has added a reference to the DAO object library.
You can do this from within the VBE by selecting the menu Tools, References and selecting Microsoft DAO x.xx Object Library.
 
Upvote 0
Thanks Andrew

Sorry to sound so stupid but I’ve not delved it to this sort of code before.

That’s cleared that error, but now It’s coming up with another:

Compile error: Sub or Function not defined, this highlights ‘RS2WS’ near the bottom of the code!

I really appreciate your help!

Cheers

Ryan A UK
 
Upvote 0
Sorry Andrew

I'd not added the full code!!! Deeeeeeeeeeeeeerrrrrrrrr :oops: :oops: :oops:

It now works perfect many thanks mate! :lol:

Cheers

Ryan A UK :-? :P :D :o
 
Upvote 0
Dear Andrew Poulsom if you are there??? :lol: :idea:


Do you know how TO make this code write back to the original workbook? You know if I make some changes and want to save them to the closed workbook!

This is the code I'm now using:

Sub GetWorksheetData(strSourceFile As String, strSQL As String, TargetCell As Range)
Dim db As DAO.Database, rs As DAO.Recordset, f As Integer, r As Long
If TargetCell Is Nothing Then Exit Sub

On Error Resume Next

Set db = OpenDatabase(strSourceFile, False, False, "Excel 8.0;HDR=Yes;")

On Error GoTo 0
If db Is Nothing Then
MsgBox "Can't find the file!", vbExclamation, ThisWorkbook.Name
Exit Sub
End If



' open a recordset
On Error Resume Next
Set rs = db.OpenRecordset(strSQL)

On Error GoTo 0
If rs Is Nothing Then
MsgBox "Can't open the file!", vbExclamation, ThisWorkbook.Name
db.Close
Set db = Nothing
Exit Sub
End If

RS2WS rs, TargetCell

rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub

Sub RS2WS(rs As DAO.Recordset, TargetCell As Range)
Dim f As Integer, r As Long, c As Long
If rs Is Nothing Then Exit Sub
If TargetCell Is Nothing Then Exit Sub

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.StatusBar = "Writing data from recordset..."
End With

With TargetCell.Cells(1, 1)
r = .Row
c = .Column
End With

With TargetCell.Parent
.Range(.Cells(r, c), .Cells(.Rows.Count, c + rs.Fields.Count - 1)).Clear
' clear existing contents
' write column headers
For f = 0 To rs.Fields.Count - 1
On Error Resume Next
.Cells(r, c + f).Formula = rs.Fields(f).Name
On Error GoTo 0
Next f
' write records
On Error Resume Next
rs.MoveFirst
On Error GoTo 0
Do While Not rs.EOF
r = r + 1
For f = 0 To rs.Fields.Count - 1
On Error Resume Next
.Cells(r, c + f).Formula = rs.Fields(f).Value
On Error GoTo 0
Next f
rs.MoveNext
Loop
.Rows(TargetCell.Cells(1, 1).Row).Font.Bold = True
.Columns("A:IV").AutoFit
End With

With Application
.StatusBar = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub


Sub getdata()
GetWorksheetData "C:\Island.xls", "SELECT * FROM [Island$]", _
ThisWorkbook.Worksheets(1).Range("A3")

End Sub

Thanks in Advance :P

Ryan A UK :roll:
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
Using SQL to extract results
Replies
2
Views
258
tiredofit
T
L
  • Solved
Querying access db from excel - 32 bit to 64 bit conversion
Replies
2
Views
723
JEC
JEC
T
  • Solved
Problem with date format when reading from workbook via SQL / ADODB
Replies
7
Views
782
Thebatfink
T
R
  • Question Question
Compose Email VBA Help
Replies
1
Views
50
Logit
Logit
C
  • Question Question
VBA Consolidating Multiple Sheets in a Pivot Table
Replies
1
Views
313
c_clark
C

Forum statistics

Threads
1,223,898
Messages
6,175,274
Members
452,628
Latest member
dd2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top