How to copy data from closed workbooks (keeping them closed) into master workbook using VBA?

by

Try this. It works using ADO without opening a source file:

Sub TransferData()
Dim sourceFile As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

sourceFile = "C:\Bel.xls"

GetData sourceFile, "Daily Figures", "A13:j102", Sheets("Data - Daily").Range("N2"), False, False

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Public Sub GetData(sourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
' http://www.rondebruin.nl/ado.htm

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

More Related Contents:

  1. How to copy only values in excel vba from a range?
  2. Excel Number Separation [closed]
  3. excel vba compare & copy worksheets from 2 excel files
  4. VBA Stuck after certain loop
  5. Is the . in .Range necessary when defined by .Cells?
  6. How to return a result from a VBA function
  7. Cycle through sub-folders and files in a user-specified root directory [duplicate]
  8. Convert Text to Date?
  9. Loop through each cell in a range of cells when given a Range object
  10. Checking for #N/A in Excel cell from VBA code
  11. Non-web SQL Injection
  12. Properly Handling Errors in VBA (Excel)
  13. Password hash function for Excel VBA
  14. Is there a way to slow down a Web Scraper so it will pick up the code?
  15. Create a folder and sub folder in Excel VBA
  16. Aggregate, Collate and Transpose rows into columns
  17. VBA Excel sort range by specific column
  18. Select method of Range class failed via VBA
  19. Renaming Files with Excel VBA
  20. Is there a way to import data from .csv to active excel sheet?
  21. Comparison of Dictionary, Collections and Arrays
  22. Break out of a While…Wend loop
  23. How to add events to dynamically created controls (buttons, listboxes) in Excel VBA userform
  24. How to make safe API Timers in VBA?
  25. Handle “No cells were found” error when filtered range is empty
  26. Excel: the Incredible Shrinking and Expanding Controls [closed]
  27. How to send email to multiple recipients with addresses stored in Excel?
  28. Generate Word Documents (in Excel VBA) from a series of Document Templates
  29. Using Excel VBA Macro To Capture + Save Screenshot of Specific Area In Same File
  30. How to protect Excel workbook using VBA?

Leave a Comment