Error With ADO (Starting to pull my hair out)
 

Hi there,

I posted a similiar question yesterday, and thought the answers had cracked
the problem, however I am still having difficulties. The code I have in my
modules is below and is copied exactly from Rob De Bruin's example.

the problem I have is this:- The code is meant to go to a closed workbook,
copy a range and then paste the range in the open workbook. Each time I get
the following error message "The file name, sheet name or range is invalid
of c:\folder\SearchResults.xls", however when I have the folder.xls open the
code works fine???

microsoft activex data objects 2.8 library is ticked

Sub GetData_Example1()
'It will copy the Header row also (the last two arguments are True)
'Change the last argument to False if you not want to copy the header row
GetData ThisWorkbook.Path & "\SearchResults.xls", "Sheet1", _
"A1:P200", Sheets("SearchResults").Range("A1"), True, True
End Sub

Option Explicit

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
sourceRange As String, TargetRange As Range, Header As
Boolean, UseHeaderRow As Boolean)
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long

If Header = False Then
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
End If

szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & sourceRange$ & "];"

On Error GoTo SomethingWrong

Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

' 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
Exit Sub

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

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function Array_Sort(ArrayList As Variant) As Variant
Dim aCnt As Integer, bCnt As Integer
Dim tempStr As String

For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1
For bCnt = aCnt + 1 To UBound(ArrayList)
If ArrayList(aCnt) ArrayList(bCnt) Then
tempStr = ArrayList(bCnt)
ArrayList(bCnt) = ArrayList(aCnt)
ArrayList(aCnt) = tempStr
End If
Next bCnt
Next aCnt
Array_Sort = ArrayList
End Function


regards BigH

Error With ADO (Starting to pull my hair out)
 

Works fine here.
Are you sure everything is names as how it should be, particularly the
sheets?

RBS

"Big H" wrote in message
...
Hi there,

I posted a similiar question yesterday, and thought the answers had
cracked the problem, however I am still having difficulties. The code I
have in my modules is below and is copied exactly from Rob De Bruin's
example.

the problem I have is this:- The code is meant to go to a closed workbook,
copy a range and then paste the range in the open workbook. Each time I
get the following error message "The file name, sheet name or range is
invalid of c:\folder\SearchResults.xls", however when I have the
folder.xls open the code works fine???

microsoft activex data objects 2.8 library is ticked

Sub GetData_Example1()
'It will copy the Header row also (the last two arguments are True)
'Change the last argument to False if you not want to copy the header row
GetData ThisWorkbook.Path & "\SearchResults.xls", "Sheet1", _
"A1:P200", Sheets("SearchResults").Range("A1"), True, True
End Sub

Option Explicit

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
sourceRange As String, TargetRange As Range, Header As
Boolean, UseHeaderRow As Boolean)
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long

If Header = False Then
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
End If

szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & sourceRange$ & "];"

On Error GoTo SomethingWrong

Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

' 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
Exit Sub

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

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function Array_Sort(ArrayList As Variant) As Variant
Dim aCnt As Integer, bCnt As Integer
Dim tempStr As String

For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1
For bCnt = aCnt + 1 To UBound(ArrayList)
If ArrayList(aCnt) ArrayList(bCnt) Then
tempStr = ArrayList(bCnt)
ArrayList(bCnt) = ArrayList(aCnt)
ArrayList(aCnt) = tempStr
End If
Next bCnt
Next aCnt
Array_Sort = ArrayList
End Function


regards BigH

Error With ADO (Starting to pull my hair out)
 

Is it working when you use the browse example in my test workbook
http://www.rondebruin.nl/ado.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl



"Big H" wrote in message ...
Hi there,

I posted a similiar question yesterday, and thought the answers had cracked the problem, however I am still having difficulties.
The code I have in my modules is below and is copied exactly from Rob De Bruin's example.

the problem I have is this:- The code is meant to go to a closed workbook, copy a range and then paste the range in the open
workbook. Each time I get the following error message "The file name, sheet name or range is invalid of
c:\folder\SearchResults.xls", however when I have the folder.xls open the code works fine???

microsoft activex data objects 2.8 library is ticked

Sub GetData_Example1()
'It will copy the Header row also (the last two arguments are True)
'Change the last argument to False if you not want to copy the header row
GetData ThisWorkbook.Path & "\SearchResults.xls", "Sheet1", _
"A1:P200", Sheets("SearchResults").Range("A1"), True, True
End Sub

Option Explicit

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
sourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long

If Header = False Then
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
End If

szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & sourceRange$ & "];"

On Error GoTo SomethingWrong

Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

' 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
Exit Sub

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

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function Array_Sort(ArrayList As Variant) As Variant
Dim aCnt As Integer, bCnt As Integer
Dim tempStr As String

For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1
For bCnt = aCnt + 1 To UBound(ArrayList)
If ArrayList(aCnt) ArrayList(bCnt) Then
tempStr = ArrayList(bCnt)
ArrayList(bCnt) = ArrayList(aCnt)
ArrayList(aCnt) = tempStr
End If
Next bCnt
Next aCnt
Array_Sort = ArrayList
End Function


regards BigH