在VBA中将关闭的工作簿数据复制到另一个打开的工作簿中？

Question

我知道这个问题可能已经被问过，但我想知道是否有可能从另一个“关闭”的工作簿复制数据到我当前打开的工作簿。我试图查找一些东西，到处都说不可能......我知道这是一个开放式的问题。

- Blake Daniel

---

打开然后关闭？将 screenupdating 设为 false。 - findwindow

不，我试图完全不打开工作簿就完成它。 - Blake Daniel

Answer 1

啊，这让我回想起几年前的事情。我相信 Ron 几年前就已经做过了（在另一个平台上解释过）。但是有两种方法可以做到。一种方法我忘记了，需要逐个获取单元格，而另一种则是下面发布的 ADO 方法。首先有两个示例子程序（一种方法可带表头，另一种则不带），然后是主 ADO 子程序。

Option Explicit

Sub GetData_ExampleV1()
' 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.xlsx", "Sheet1", _
            "A1:C5", Sheets("Sheet1").Range("A1"), True, True
End Sub


Sub GetData_ExampleC2()
' It will not copy the Header row (the last two arguments are True, False)
' Change the last argument to True if you also want to copy the header row
    GetData ThisWorkbook.Path & "\test.xlsx", "Sheet1", _
            "A1:C5", Sheets("Sheet1").Range("A1"), True, False
End Sub

这是您调用执行此操作的 ADO（函数）。

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long

    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If

    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If

    On Error GoTo SomethingWrong

    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1

    ' 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
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub

SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0

End Sub

- data_sc