View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.misc
jbhoop
 
Posts: n/a
Default allow user to select folder

Thanks to all for the help here is what I came up with, thought I would
share if anyone else needs! This will combine worksheets from multiple
files from a user selected folder.

Dim TargetWkbk As Workbook
Dim mrgWkbk As Workbook


Dim i As Long
Dim Wks As Worksheet
Dim fName As String
Dim oApp As Object
Dim oFolder
Dim foldername

Application.ScreenUpdating = False
Set TargetWkbk = Workbooks.Add(1)
ActiveSheet.Name = "dummy"

'Browse to the folder with xls files
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.BrowseForFolder(0, "Select folder with mud
files", 512)
If Not oFolder Is Nothing Then
foldername = oFolder.Self.Path
If Right(foldername, 1) < "\" Then
foldername = foldername & "\"
End If

With Application.FileSearch
.NewSearch
.LookIn = foldername 'folder to use
.SearchSubFolders = False
.Filename = "*.xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s)
found."
For i = 1 To .FoundFiles.Count
Set mrgWkbk = Workbooks.Open(.FoundFiles(i),
UpdateLinks:=0)
For Each Wks In ActiveWorkbook.Worksheets
With TargetWkbk
Wks.copy after:=.Worksheets(.Worksheets.Count)
End With
Next Wks
mrgWkbk.Close False
Next i


Application.DisplayAlerts = False
TargetWkbk.Worksheets("dummy").Delete
Application.DisplayAlerts = True


fName = Application.GetSaveAsFilename _
(fileFilter:="MS Excel Workbook (*.Xls), *.Xls")


TargetWkbk.SaveAs Filename:=fName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Else
MsgBox "There were no files found."
TargetWkbk.Close savechanges:=False
End If
End With


Application.ScreenUpdating = True
Application.EnableEvents = False

End If
End Sub