Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
allow user to select folder
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 = "c:\test" 'folder to use .SearchSubFolders = False .Filename = "*.xls" .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
allow user to select folder
XL2002 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 "shell32.dll" _ Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" _ (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 = _ "Select a folder.") As String '------------------------------------------------------------- Dim bInfo As BROWSEINFO Dim path As String Dim oDialog As Long bInfo.pidlRoot = 0& 'Root folder = Desktop bInfo.lpszTitle = Name bInfo.ulFlags = &H1 'Type of directory to Return oDialog = SHBrowseForFolder(bInfo) 'display the dialog 'Parse the result path = Space$(512) GetFolder = "" 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) "jbhoop" wrote in message oups.com... 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 = "c:\test" 'folder to use .SearchSubFolders = False .Filename = "*.xls" .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
allow user to select folder
Jim Rech has a BrowseForFolder routine at:
http://www.oaltd.co.uk/MVP/Default.htm (look for BrowseForFolder) John Walkenbach has one at: http://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: 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 = "c:\test" 'folder to use .SearchSubFolders = False .Filename = "*.xls" .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then -- Dave Peterson |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Select Text Files from Combobox | Excel Discussion (Misc queries) | |||
"Save As" folder -- can I default this to the same folder as origi | Excel Discussion (Misc queries) | |||
What is folder OLK7 and where can I find it? | Excel Discussion (Misc queries) | |||
Cannot access read-only documents. | Excel Discussion (Misc queries) | |||
Dynamic Formulas with Dynamic Ranges | Excel Worksheet Functions |