Ответить

'If you want to import a lot of data from a closed workbook you can do this with ADO and the macro below.

'If you want to retrieve data from another worksheet than the first worksheet in the closed workbook,

'you have to refer to a user defined named range. The macro below can be used like this (in Excel 2000 or later):

'GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "A1:B21", ActiveCell, False

'GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "MyDataRange", Range("B3"), True

Sub GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, _

TargetRange As Range, IncludeFieldNames As Boolean)

' требует ссылку на Microsoft ActiveX Data Objects library

' if SourceRange is a range reference:

' this will return data from the first worksheet in SourceFile

' if SourceRange is a defined name reference:

' this will return data from any worksheet in SourceFile

' SourceRange must include the range headers

'

Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset

Dim dbConnectionString As String

Dim TargetCell As Range, i As Integer

dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};" & _

"ReadOnly=1BQ=" & SourceFile

Set dbConnection = New ADODB.Connection

On Error GoTo InvalidInput

dbConnection.Open dbConnectionString ' open the database connection

Set rs = dbConnection.Execute("[" & SourceRange & "]")

Set TargetCell = TargetRange.Cells(1, 1)

If IncludeFieldNames Then

For i = 0 To rs.Fields.Count - 1

TargetCell.Offset(0, i).Formula = rs.Fields(i).Name

Next i

Set TargetCell = TargetCell.Offset(1, 0)

End If

TargetCell.CopyFromRecordset rs

rs.Close

dbConnection.Close ' close the database connection

Set TargetCell = Nothing

Set rs = Nothing

Set dbConnection = Nothing

On Error GoTo 0

Exit Sub

InvalidInput:

MsgBox "The source file or source range is invalid!", _

vbExclamation, "Get data from closed workbook"

End Sub

'Another method that doesn't use the CopyFromRecordSet-method With the macro below you can perform the import and have better control over the results returned from the RecordSet.

Sub TestReadDataFromWorkbook()

' fills data from a closed workbook in at the active cell

Dim tArray As Variant, r As Long, c As Long

tArray = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21")

' without transposing

' For r = LBound(tArray, 2) To UBound(tArray, 2)

' For c = LBound(tArray, 1) To UBound(tArray, 1)

' ActiveCell.Offset(r, c).Formula = tArray(c, r)

' Next c

' Next r

' with transposing

tArray = Application.WorksheetFunction.Transpose(tArray)

For r = LBound(tArray, 1) To UBound(tArray, 1)

For c = LBound(tArray, 2) To UBound(tArray, 2)

ActiveCell.Offset(r - 1, c - 1).Formula = tArray(r, c)

Next c

Next r

End Sub

Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As String) As Variant

' requires a reference to the Microsoft ActiveX Data Objects library

' if SourceRange is a range reference:

' this function can only return data from the first worksheet in SourceFile

' if SourceRange is a defined name reference:

' this function can return data from any worksheet in SourceFile

' SourceRange must include the range headers

' examples:

' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:A21")

' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21")

' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "DefinedRangeName")

Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset

Dim dbConnectionString As String

dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1BQ=" & SourceFile

Set dbConnection = New ADODB.Connection

On Error GoTo InvalidInput

dbConnection.Open dbConnectionString ' open the database connection

Set rs = dbConnection.Execute("[" & SourceRange & "]")

On Error GoTo 0

ReadDataFromWorkbook = rs.GetRows ' returns a two dim array with all records in rs

rs.Close

dbConnection.Close ' close the database connection

Set rs = Nothing

Set dbConnection = Nothing

On Error GoTo 0

Exit Function

InvalidInput:

MsgBox "The source file or source range is invalid!", vbExclamation, "Get data from closed workbook"

Set rs = Nothing

Set dbConnection = Nothing

End Function

'The macro example assumes that your VBA project has added a reference to the ADO object library.

'You can do this from within the VBE by selecting the menu Tools, References and selecting Microsoft

'ActiveX Data Objects x.x Object Library.

'Use ADO if you can choose between ADO and DAO for data import or export.

Ответить