ADO functionality.. copy, filter, paste from close

2019-09-13 02:25发布

I am currently looking for an alternative to the solution below, but using the ADO functionality so that the source workbook isn't opened. I am imagining this will decrease processing time?

Your thoughts..

Thanks

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

2条回答
小情绪 Triste *
2楼-- · 2019-09-13 03:07

You could use a reference to Active X Data Objects 6.0, to use SQL queries

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

Where the CriteriaColumn is the Header of the Column used as criteria to filter

You can call the subroutine as follows:

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
查看更多
对你真心纯属浪费
3楼-- · 2019-09-13 03:26

You are missing this line:

Set rs = CreateObject("ADODB.Recordset")

For some reason Win XP will not run without it. It should be placed right after con.Open conStr.

查看更多
登录 后发表回答