Macro to append multiple xls file in single workbook from specified path

Hi all
I need a macro to do the following
1.Get list of .xls files from specified folder.
2.Append the files in new workbook in same folder.

Ex:
D:/users/excel/Sample_sheet1.xls
D:/users/excel/Sample_sheet2.xls
D:/users/excel/Sample_sheet3.xls

I want to get the list of Sample_*.xls and
create Sample.xls master file which adds the above three .xls as sheets in it.

Actually my macro as below

Sub GetExcelFileData() 
Dim strFilePath As String, strFilename As String, strFullPath As String 
Dim lngCounter As Long 
Dim oConn As Object, oRS As Object, oFSObj As Object 
Dim fileItem As Object 

Application.ScreenUpdating = False 

'This gives us a full path name e.g. C:tempfolderfile.txt 
'We need to split this into path and file name 
Set oFSObj = CreateObject("SCRIPTING.FILESYSTEMOBJECT") 

Set srcFolder = oFSObj.GetFolder(ThisWorkbook.Path) 

'Open an ADO connection to the folder specified 
Set oConn = CreateObject("ADODB.CONNECTION") 
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
"Data Source=" & ThisWorkbook.Path & ";" & _ 
"Extended Properties='Excel 8.0;HDR=Yes';" 

Set oRS = CreateObject("ADODB.RECORDSET") 

lngCounter = 1 

'Now actually open the excel file and import into Excel 
For Each fileItem In srcFolder.Files 

strFile = fileItem.Name 

If Right(fileItem.Name, 4) = ".xls" And InStr(fileItem.Name, Left(strFile, InStr(strFile, ".") - 1)) = 1 Then 

oRS.Open "SELECT * FROM " & strFile, oConn, 3, 1, 1 
While Not oRS.EOF 
If lngCounter > 1 Then 
Sheets.Add After:=Worksheets(Worksheets.Count) 
Else 
lngCounter = 2 
End If 

ActiveSheet.Range("A1").CopyFromRecordset (oRS) 
Wend 
oRS.Close 
Columns("A:IV").AutoFit 
End If 
Next 

oConn.Close 

ActiveWorkbook.Saved = True 

End Sub

The main .xls has created and while im trying to open its throwing the below warning.

Run-time error '-2147467259 (80004005)':

The Microsoft Jet Database engine cannot open the file
\\testsystem\testdomain\exceloutput\. It is already oppened
exlusively by another user , or you need permission to view its data.

Could you please anyone help me on this....

You'll need to edit the post above and put code tags around all that code, as per Forum Rules.

There's probably an easier approach. Questions:

1) How many sheets are in the sample sheets? Just 1? If so we can just import the sheet that is active when the sheet(s) are opened, yes?
2) What do you want to name this consolidated workbook?
3) The sheets that are being imported...are they all named the same thing in their individual workbooks? If so, how do you want them named in the consolidated workbook?

Please provide answers to those questions after you fix the code tags. Thanks.

You didn't answer the questions #1 and #3 that I asked. And #2 can use a little clarification, too.


1) If we were to actually open one of these SampleN.xls workbooks, how many sheets of data IN THE WORKBOOK require importing? 1 sheet? 2 sheets?

If it's just 1 sheet, is that the ONLY sheet in the workbook or will we need to know the sheet's name? (Sheet1, Sheet2, etc?)

2) It would actually be a little easier if the consolidated workbook name wasn't an exact match name to the other workbooks at the beginning. So how about naming it SUMMARY_Sample.xls?

This makes me ask, Sample_sheet1.xls sounds like something you made up for this forum question. When making macros, it's important to know what's real and what's not.

For instance, I'm going to structure the macro to open EVERY file in the specified folder with any name other than SUMMARY*.xls, will that work for your setup?

3) In the SUMMARY_Sample.xls workbook, each sheet we import needs a UNIQUE name. What naming structure do you want for the sheets that are being imported?

===============

Originally Posted by JBeaucaire

3) In the SUMMARY_Sample.xls workbook, each sheet we import needs a UNIQUE name. What naming structure do you want for the sheets that are being imported?

Please advise.

Also:

4) My standard consolidation macro is designed to simply open every file in the folder programmed and process them. Is that OK?

5) Each time the macro is run, should it:
a) clear the existing report of imported sheets so that the new report only has the new imported data?
b) simply ADD the new data sheets, so each time it runs the summary book just keeps growing?

6) If you choose 5b) then after each document is imported, should we mark it as "imported" in same manner so that it doesn't get imported a second time should the macro be run again?

We could:
a) make a change to the document name to indicate it was already imported
b) move the document to another folder, and "imported" folder so it's no longer in the "to be imported" folder
c) both
d) do nothing, you will handle the management of the files

Fingers crossed...put this into the Summary workbook, properly named. Put that workbook into the same folder as the files to consolidate. The macro will detect the filename and the folder path, so it should be ready to go.

Option Explicit

Sub Consolidate()
'Open all Excel files in a specific folder and import data as separate sheets
'Sheet name is matched to this consolidation file and only those files imported
'JBeaucaire (7/6/2009   2/5/2010)     (2007 compatible)
Dim fName As String, fKey As String, fPath As String, Cnt As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Set wbkNew = ThisWorkbook
wbkNew.Activate

fPath = ThisWorkbook.Path & "\"

fKey = Left(Mid(ThisWorkbook.Name, 9), InStrRev(Mid(ThisWorkbook.Name, 9), ".") - 1)
fName = Dir(fPath & fKey & "*.xls")

'Clear existing sheets
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    For Each ws In Worksheets
        If ws.Name <> "Temp" Then ws.Delete
    Next ws
    
'Import first active sheet from found file
    Do While Len(fName) > 0
        Cnt = Cnt + 1
        Set wbkOld = Workbooks.Open(fPath & fName)
        ActiveSheet.Name = "Sheet-" & Cnt
        ActiveSheet.Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
        fName = Dir
        wbkOld.Close False
    Loop
    
wbkNew.Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

1) What is the name of the file that holds this macro?
2) What is the full path to the folder where this file resides?
3) What is the full path to the folder with the files to import?

4) When you get a syntax error, click on DEBUG and which line of code is highlighted?
5) Hold your mouse over each of the variables on that line of code...what are the values stored in those variables at the moment you're debugging? At least one will show an error...which one?

Hi,
Please find my response for your clarifications.

1) The name of the file that hold the macro is SUMMARY_FINALIZEDDISTLIST_020420100541.xls
2) Its in D:/sys/bea/userprojects/irsdomain/logs/Excel/ folder
3) The files to import full pathh is D:/sys/bea/userprojects/irsdomain/logs/Excel/ folder
4) While opening SUMMARY_FINALIZEDDISTLIST_020420100541.xls file im getting this error.
5) In the below code the highlighted part shown as error.
<CODE>
For Each ws In Worksheets
If ws.Name <> "Temp" Then ws.Delete
Next ws

'Import first active sheet from found file
Do While Len(fName) > 0
Cnt = Cnt + 1
Set wbkOld = Workbooks.Open(fPath & fName)
ActiveSheet.Name = "Sheet-" & Cnt
ActiveSheet.Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
fName = Dir
wbkOld.Close False
Loop
</CODE>