Question

我目前正在寻找下面解决方案的替代方案，但使用ADO功能，以便不打开源工作簿。我想这会减少处理时间吗？

你的想法......

由于

Sub CopyFilteredValuesToActiveWorkbook()

    Dim wbSource As Workbook, wbDest As Workbook
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim rngSource As Range, rngDest As Range

    Set wbSource = Workbooks.Open("\\Linkstation\rrm\X_DO_NOT_TOUCH_CC\MasterLogFile\Masterlogfile.xlsx", , True) 'Readonly = True
    Set wsSource = wbSource.Worksheets("LogData")
    wsSource.Range("$A$1:$H$3").AutoFilter Field:=3, Criteria1:="Opera"
    Set rngSource = wsSource.Range("A:Z")

    Set wbDest = ThisWorkbook
    Set wsDest = wbDest.Worksheets("MLF")
    Set rngDest = wsDest.Range("A:Z")

    rngDest.Value = rngSource.Value 'Copies values over only, if you need formatting etc we'll need to use something else

    wbSource.Close (False) 'Close without saving changes

    End Sub

Answer 1

您可以使用对Active X Data Objects 6.0的引用来使用SQL查询

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1

Public Sub GetValues (path as String, destination as Range)
    Dim conStr as String, strSQL as string
    Dim con as new ADODB.Connection, rs as new ADODB.Recordset

    conStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & path & "';" & _
             "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";"
    strSQL = "SELECT * FROM [LogData$] WHERE [CriteriaColumn] = 'Opera'"

    con.Open conStr
    rs.open strSQL, con, adOpenStatic, adLockOptimistic, adCmdText
    destination.CopyFromRecordset rs
    rs.close
    con.close
End Sub

CriteriaColumn是用作过滤条件的列的标题

您可以按如下方式调用子程序：

Dim path as string, rngDest as Range
path = "\\Linkstation\rrm\X_DO_NOT_TOUCH_CC\MasterLogFile\Masterlogfile.xlsx"
'The Upper left cell of the range that will receive the data:
Set rngDest = ThisWorkbook.Worksheets("MLF").Range("A1") 
GetValues path, rngDest

Answer 2

你错过了这一行：

Set rs = CreateObject("ADODB.Recordset")

出于某种原因，没有它，Win XP将无法运行。它应该放在con.Open conStr之后。

ADO功能..复制，过滤，粘贴从已关闭的工作簿到activeworkbook

2 个答案: