Re: 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" <hsjewebster@xxxxxxx> wrote in message news:umtYmII%23GHA.4524@xxxxxxxxxxxxxxxxxxxxxxx
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, *** 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, Source*** 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 [" & Source***$ & "$" & 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, *** name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub

Function LastRow(sh As Work***)
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


.

Quantcast