software

I am using the following code to merge some files, can someone help me
figure out how to code it so that when macro command button is hit a
prompt window will come up allowing user to select folder and location
for files to be merged.

With Application.FileSearch
.NewSearch
.LookIn = quot;c:\testquot; 'folder to use
.SearchSubFolders = False
.Filename = quot;*.xlsquot;
.FileType = msoFileTypeExcelWorkbooks
If .Execute() gt; 0 ThenXL2002 has a browse dialog. I don't use 2002 myself, so you may need to
play with this, but this is basically it

With Application.FileDialog(msoFileDialogFolderPicker)
.Show

MsgBox .SelectedItems(1)

End With

Look up FileDialog in the VBA help

The pre XL2002 way is

Private Declare Function SHGetPathFromIDList Lib quot;shell32.dllquot; _
Alias quot;SHGetPathFromIDListAquot; _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib quot;shell32.dllquot; _
Alias quot;SHBrowseForFolderAquot; _
(lpBrowseInfo As BROWSEINFO) As Long

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'-------------------------------------------------------------
Function GetFolder(Optional ByVal Name As String = _
quot;Select a folder.quot;) As String
'-------------------------------------------------------------
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long

bInfo.pidlRoot = 0amp; 'Root folder = Desktop

bInfo.lpszTitle = Name

bInfo.ulFlags = amp;H1 'Type of directory to Return
oDialog = SHBrowseForFolder(bInfo) 'display the dialog

'Parse the result
path = Space$(512)

GetFolder = quot;quot;
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If

End Function

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

quot;jbhoopquot; gt; wrote in message oups.com...
gt; I am using the following code to merge some files, can someone help me
gt; figure out how to code it so that when macro command button is hit a
gt; prompt window will come up allowing user to select folder and location
gt; for files to be merged.
gt;
gt; With Application.FileSearch
gt; .NewSearch
gt; .LookIn = quot;c:\testquot; 'folder to use
gt; .SearchSubFolders = False
gt; .Filename = quot;*.xlsquot;
gt; .FileType = msoFileTypeExcelWorkbooks
gt; If .Execute() gt; 0 Then
gt;
Jim Rech has a BrowseForFolder routine at:
www.oaltd.co.uk/MVP/Default.htm
(look for BrowseForFolder)

John Walkenbach has one at:
j-walk.com/ss/excel/tips/tip29.htm

If you and all your users are running xl2002 , take a look at VBA's help for:
application.filedialog(msoFileDialogFolderPicker)

jbhoop wrote:
gt;
gt; I am using the following code to merge some files, can someone help me
gt; figure out how to code it so that when macro command button is hit a
gt; prompt window will come up allowing user to select folder and location
gt; for files to be merged.
gt;
gt; With Application.FileSearch
gt; .NewSearch
gt; .LookIn = quot;c:\testquot; 'folder to use
gt; .SearchSubFolders = False
gt; .Filename = quot;*.xlsquot;
gt; .FileType = msoFileTypeExcelWorkbooks
gt; If .Execute() gt; 0 Then

--

Dave Peterson

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 WorkbookDim 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 = quot;dummyquot;

'Browse to the folder with xls files
Set oApp = CreateObject(quot;Shell.Applicationquot;)
Set oFolder = oApp.BrowseForFolder(0, quot;Select folder with mud
filesquot;, 512)
If Not oFolder Is Nothing Then
foldername = oFolder.Self.Path
If Right(foldername, 1) lt;gt; quot;\quot; Then
foldername = foldername amp; quot;\quot;
End If

With Application.FileSearch
.NewSearch
.LookIn = foldername 'folder to use
.SearchSubFolders = False
.Filename = quot;*.xlsquot;
.FileType = msoFileTypeExcelWorkbooks
If .Execute() gt; 0 Then
MsgBox quot;There were quot; amp; .FoundFiles.Count amp; quot; file(s)
found.quot;
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 iApplication.DisplayAlerts = False
TargetWkbk.Worksheets(quot;dummyquot;).Delete
Application.DisplayAlerts = TruefName = Application.GetSaveAsFilename _
(fileFilter:=quot;MS Excel Workbook (*.Xls), *.Xlsquot;)TargetWkbk.SaveAs Filename:=fName, FileFormat:=xlNormal, _
Password:=quot;quot;, WriteResPassword:=quot;quot;, _
ReadOnlyRecommended:=False, CreateBackup:=False
Else
MsgBox quot;There were no files found.quot;
TargetWkbk.Close savechanges:=False
End If
End WithApplication.ScreenUpdating = True
Application.EnableEvents = False

End If
End Sub