Follow up question. Get value of closed file.

S

Steven

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 ;
 
J

Joel

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"
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 ;
Click to expand...
 
S

Steven

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 said:
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"
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 ;
Click to expand...
Click to expand...
 
J

Joel

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 said:
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 said:
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"
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 ;
Click to expand...
Click to expand...
Click to expand...
 
S

Steven

Thank you Joel,

I cannot get it to work yet but I will continue trying. I tried to return
MsgBox ReturnData and it said type mismatch. And now I have an issue of
what if the file I am getting the data from is passworded? I feel I am
occupying your time and vastly superior knowledge. If you can give me one
last direction I would certainly appriciate it.

Thank you,

Steven

Joel said:
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 said:
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 said:
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


:

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 ;
Click to expand...
Click to expand...
Click to expand...
 
J

Joel

1) I don't think you really know how to use arrays. You can't just put an
array into a mesage box. You havve to access each member of the array
individually.

a single dimension array
for i = 0 to upperbound(ReturnData - 1)
msgbox(returndata(i))
next i


a double dimension array
for i = 0 to upperbound(ReturnData - 1)
msgbox(returndata(i,0))
msgbox(returndata(i,1))
next i

I would unprotext the file for testing and add the password back after you
get everything working. I'm not sure of the syntax to add the pasword to the
commands for reading a close file.

Steven said:
Thank you Joel,

I cannot get it to work yet but I will continue trying. I tried to return
MsgBox ReturnData and it said type mismatch. And now I have an issue of
what if the file I am getting the data from is passworded? I feel I am
occupying your time and vastly superior knowledge. If you can give me one
last direction I would certainly appriciate it.

Thank you,

Steven

Joel said:
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 said:
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

:

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


:

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 ;
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Problem when copying a range from closed workbooks (ADO) 4
SQL String 1
SQL not importing records from ACCDB 2
ADO access to excel workbook on website 1
Error With ADO (Starting to pull my hair out) 2
Compile Error (ADO) Ron De Bruin 2
Copy Data from Excel 2007 XLSM workbook to Excel 2003 XLS workbook using ADO 2
Importing .xlsm, .xlsx with OLEDB 5

Top