Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Follow up question. Get value of closed file.
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 389
Default Follow up question. Get value of closed file.
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 ;


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Follow up question. Get value of closed file.
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 ;


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 389
Default Follow up question. Get value of closed file.
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 ;


Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Follow up question. Get value of closed file.
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 ;


Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 389
Default Follow up question. Get value of closed file.
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" wrote:

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 ;


Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Follow up question. Get value of closed file.
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" wrote:

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" wrote:

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 ;


Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Follow Up Macro Question MrAcquire Excel Discussion (Misc queries) 4 February 12th 10 04:55 PM
A follow up Question Andrew Mackenzie Excel Discussion (Misc queries) 4 November 17th 08 02:50 PM
Follow-up AVERAGEIF question Ken[_3_] New Users to Excel 2 April 11th 08 05:45 PM
Hyperlink.Follow question Leo Excel Programming 0 June 3rd 07 06:28 AM
Follow-Up (Clarification) to MIN question Odawg Excel Discussion (Misc queries) 4 October 20th 05 04:04 AM


All times are GMT +1. The time now is 06:54 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement