Read/Write data to a closed workbook?

[razzandy]

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

 

[Andrew Poulsom]

I am not sure, but see:

http://support.microsoft.com/default.aspx?scid=kb;en-us;Q278973

 

[clares]

Hi All

I am trying to use this code so that I can read/write from a closed workbook but I am getting various errors. Can I just comfirm where I place this code, either in the personal.xls module, in the workbook that is closed, except this gives me an activeX error, or somewhere else?

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, True, "Excel 8.0;HDR=Yes;") 
' read only 
'Set db = OpenDatabase(strSourceFile, False, False, "Excel 8.0;HDR=Yes;") 
' write 
'Set db = OpenDatabase("C:\Foldername\Filename.xls", False, True, _ 
"Excel 8.0;HDR=Yes;") ' read only 
'Set db = OpenDatabase("C:\Foldername\Filename.xls", False, False, _ 
"Excel 8.0;HDR=Yes;") ' write 
On Error GoTo 0 
If db Is Nothing Then 
MsgBox "Can't find the file!", vbExclamation, ThisWorkbook.Name 
Exit Sub 
End If 

' ' list worksheet names 
' For f = 0 To db.TableDefs.Count - 1 
' Debug.Print db.TableDefs(f).Name 
' Next f 

' open a recordset 
On Error Resume Next 
Set rs = db.OpenRecordset(strSQL) 
' Set rs = db.OpenRecordset("SELECT * FROM [SheetName$]") 
' Set rs = db.OpenRecordset("SELECT * FROM [SheetName$] " & _ 
"WHERE [Field Name] LIKE 'A*'") 
' Set rs = db.OpenRecordset("SELECT * FROM [SheetName$] " & _ 
"WHERE [Field Name] LIKE 'A*' ORDER BY [Field Name]") 
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 getdata() 
GetWorksheetData "C:\Data Table.xls", "SELECT * FROM [Sheet1$]", ThisWorkbook.Worksheets(1).Range("A3") 

End Sub

Kind Regards

Peter