"TK" wrote ...

I merely offered a little plug and play code to get the OP who was trying to
learn to write to a closed workbook moving in the right direction.

I merely challenged some statements you made which I saw as being
incorrect.

You suggest to use my code he must adjust the Jet registry keys.

I thought *you* may have been having problems but it seems I thought
wrong.

€œdetails on the relevant registry settings and how you may change them in
your favor, see€�
Who will do that?

Unless the administrator has locked them down, why not change them in
one's favor if they are causing problems? Isn't that the point of
having these values in the registry rather than hard coding them?

why not append or suggest ways to improve the
procedure or offer one of your own.

I didn't want to answer a question that has already been answered (I
assume; I haven't checked your code). But since you've laid down the
gauntlet, here's my attempt:

Sub test()
Dim vntResult As Variant
vntResult = GetCellContentsFromClosedWorkbook( _
"C:\Tempo\db.xls", "Sheet1", "A2")

If vntResult = vbEmpty Then
MsgBox "Error fetching cell contents."
Exit Sub
End If

If IsNull(vntResult) Then
MsgBox "Result is null." & vntResult
Else
MsgBox "Result=" & CStr(vntResult)
End If
End Sub

Public Function GetCellContentsFromClosedWorkbook( _
ByVal FullFilename As String, _
ByVal SheetName As String, _
ByVal CellAddress As String _
) As Variant

Dim Con As Object
Dim rs As Object
Dim strCon As String
Dim strSql1 As String
Dim strCellAddress As String
Dim lngStart As Long
Dim lngEnd As Long

Const CONN_STRING As String = "" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<FULL_FILENAME;" & _
"Extended Properties='Excel 8.0;HDR=NO'"

Const SQL As String = "" & _
"SELECT F1 FROM [" & _
"<SHEET_NAME$" & _
"<CELL_ADDRESS:<CELL_ADDRESS]"

' Build connection string
strCon = CONN_STRING
strCon = Replace(strCon, _
"<FULL_FILENAME", FullFilename)

' Build sql statement
strSql1 = SQL

' Get first cell from address
strCellAddress = Replace(CellAddress, _
"$", vbNullString)
On Error Resume Next
lngStart = InStr(strCellAddress, "!") + 1
lngEnd = InStr(lngStart, strCellAddress, ":")
strCellAddress = Mid$(strCellAddress, _
lngStart, lngEnd - lngStart)
On Error GoTo 0

' Build sql text
strSql1 = SQL
strSql1 = Replace(strSql1, _
"<SHEET_NAME", SheetName)
strSql1 = Replace(strSql1, _
"<CELL_ADDRESS", strCellAddress)

' Open connection to temp workbook
Set Con = CreateObject("ADODB.Connection")
With Con
.ConnectionString = strCon

On Error Resume Next
.Open
Set rs = .Execute(strSql1)
GetCellContentsFromClosedWorkbook = _
rs.fields(0).Value
On Error GoTo 0

.Close
End With

End Function


Jamie.

--