Append data from Multiple workbooks without opening the workbooks

Sub Main

Call AppendData

End Sub

 

 

Function GetFolder(ByVal DefaultPath As String)

On Error Resume Next

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
jmp1:

With fd
.InitialFileName = DefaultPath & "\"
.Show
End With

GetFolder = fd.SelectedItems(1)
If GetFolder = Empty Then GoTo errHandler
Exit Function
errHandler:
MsgBox "Please select a folder."
GoTo jmp1

End Function

 

 

Sub AppendData()

Dim folderpath As String
Dim cnt As DAO.Database
Dim rst As DAO.Recordset

Sheets(1).Select
Range("A2").Select

folderpath = GetFolder("C:")

With Application.FileSearch
.NewSearch
.LookIn = folderpath
.SearchSubFolders = False
.Filename = "*.xls"
.Execute
   
    For i = 1 To .FoundFiles.Count
   
        Set cnt = DBEngine.OpenDatabase(.FoundFiles(i), False, False, "Excel 8.0")
        Set rst = cnt.OpenRecordset("Sheet1$")

        ActiveCell.CopyFromRecordset rst
        Cells(Range("E1").End(xlDown).Row + 1, 1).Select

        rst.Close
        cnt.Close
       
    Next
   
   
End With

End Sub

 

For worksheet example check this url http://groups.google.co.in/group/myvbagroup?hl=en

 

---

See the Web's breaking stories, chosen by people like you. Check out Yahoo! Buzz.