Sub GetData_Example3()
1)
'In this example Header = False and UseHeaderRow can be True or False
'because it Is Not used

Dim ReturnData as Variant

GetData ThisWorkbook.Path & "\Macro-GetCellSource.xls", "Sheet1", _
"A2025:A2025", Sheets("Sheet1").Range("B10"), False, False, ReturnData

End Sub

2) Change
from
ReturnData = Nothing
to
set ReturnData = Nothing

"Steven" wrote:

Joel,

Thank you for your response. I still cannot make it work. I setup what you
have for the Public Sub GetData(..............) ............. End Sub and
changed my GetData_Example3() to add , True at the end. When I tried to run
it it gave me an error first on ReturnData = Nothing.

My ultimate goal is to return the value of 1 cell in the closed file to a
variable, and if possible without writing the value to a cell. This is
definitely new ground for me. Can you show me how this works and then return
the variable at the end with MsgBox ......

Thank you,

Steven

Sub GetData_Example3()
'In this example Header = False and UseHeaderRow can be True or False
'because it Is Not used

GetData ThisWorkbook.Path & "\Macro-GetCellSource.xls", "Sheet1", _
"A2025:A2025", Sheets("Sheet1").Range("B10"), False, False, True

End Sub

"Joel" wrote:

You need to return an array. You can either make the routine a function and
return the array or pass the array as a parameter in the sub and make the
variable BYREF.

Option Explicit


Public Sub GetData(SourceFile As Variant, _
SourceSheet As String, _
SourceRange As String, _
TargetRange As Range, _
Header As Boolean, _
UseHeaderRow As Boolean, _
ByRef ReturnData As Variant)

' 1-Jul-2008, working in Excel 2000-2007
Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long

ReturnData = Nothing
' Create the connection string.
If Header = False Then
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No"";"
End If
Else
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
End If

If SourceSheet = "" Then
' workbook level name
szSQL = "SELECT * FROM " & SourceRange$ & ";"
Else
' worksheet level name or range
szSQL = "SELECT * FROM [" & _
SourceSheet$ & "$" & SourceRange$ & "];"
End If

On Error GoTo SomethingWrong

Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")

rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1

' Check to make sure we received data and copy the data
If Not rsData.EOF Then

If Header = True And _
UseHeaderRow = True Then

ReDim ReturnData(rsData.Fields.Count, 2)
For lCount = 0 To rsData.Fields.Count - 1

ReturnData(lCount, 1) = rsData.Fields(lCount).Name
ReturnData(lCount, 2) = rsData.Fields(lCount).Value
Next lCount
Else
ReDim ReturnData(rsData.Fields.Count)
For lCount = 0 To rsData.Fields.Count - 1
ReturnData(lCount) = rsData.Fields(lCount).Value
Next lCount
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If

' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub

SomethingWrong:
MsgBox _
"The file name, Sheet name or Range is invalid of : " & _
SourceFile, vbExclamation, "Error"
On Error GoTo 0
End Sub


"Steven" wrote:

I earlier in the month asked how, in code, do you get the value of a cell
without opening the file. Below is the response which works get. But,
instead of putting the value in a worksheet cell as this solution does, I
want to save the value to a variable. How do I do that?

Thank you,

Steven
----------------------------------------------------------------------------------------
Try an ADO macro ; first , copy this macro in a wbook !
__________________________________________________ _____________

Option Explicit


Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
SourceRange As String, TargetRange As Range, Header
As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long

' Create the connection string.
If Header = False Then
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No"";"
End If
Else
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
End If

If SourceSheet = "" Then
' workbook level name
szSQL = "SELECT * FROM " & SourceRange$ & ";"
Else
' worksheet level name or range
szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$
& "];"
End If

On Error GoTo SomethingWrong

Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")

rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1

' Check to make sure we received data and copy the data
If Not rsData.EOF Then

If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
'Add the header cell in each column if the last argument
is True
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If

Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If

' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub

SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " &
SourceFile, _
vbExclamation, "Error"
On Error GoTo 0

End Sub
__________________________________________________ _________________________

Then , copy and this macro , too :

Sub GetData_Example3()
' In this example Header = False and UseHeaderRow can be True or False
because it is not used

GetData ThisWorkbook.Path & "\test.xls", "Sheet1", _
"A3:C4", Sheets("Sheet1").Range("A1"), False, False

End Sub

change test.xls , sheets name and range according with your needs ;