Hi there,
Did you set a reference to the Microsoft ActiveX Data Objects 2.x
Library in Tools|References?
Ken Puls, CMA - Microsoft MVP (Excel)
www.excelguru.ca
Big H wrote:
> Hi there,
>
> Hopefully someone can help, I am trying to copy data from a closed workbook,
> I am copying the modules used in the example on Ron De Bruin's web site. I
> even imported the modules onto an other workbook to try that out, however I
> always get an compile error "User -defined type not defined", yet the
> workbooks I downloaded work perfectly from Ron's site.
>
> The workbook with the code is called Harry ADO.xls and the file I want to
> copy is called Test.xls both workbooks are in the same folder
>
> here is the code
>
> 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 'THE ERROR IS ALWAYS HERE
> 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
>
>
> Here is the macro I am trying to run
>
> 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 & "\test.xls", "Sheet1", _
> "A1:C5", Sheets("Sheet1").Range("A1"), True, True
> End Sub
>
>
>
> regards BigH
>
>
Similar Threads
