Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Merge 2 pieces of code
Hi everyone. I have 2 separate pieces of code: 1 allows the user to browse
to and select a directory. The second opens all files within a flder directory. In that piece, the folder path is predefined as a variable. I would love to make that piece dynamic to allow for the user to browse to the folder, read that folder as a variable, and apply it to the second piece of code. The code is below. Thanks for your help!! Get Directory Code: Option Explicit Public 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 '32-bit API declarations Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _ As Long Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Sub Test() Dim Msg As String Dim x As Variant Msg = "Please select a location for the backup." MsgBox GetDirectory(Msg) End Sub Function GetDirectory(Optional Msg) As String Dim bInfo As BROWSEINFO Dim path As String Dim r As Long, x As Long, pos As Integer ' Root folder = Desktop bInfo.pidlRoot = 0& ' Title in the dialog If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." Else bInfo.lpszTitle = Msg End If ' Type of directory to return bInfo.ulFlags = &H1 ' Display the dialog x = SHBrowseForFolder(bInfo) ' Parse the result path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetDirectory = Left(path, pos - 1) Else GetDirectory = "" End If End Function Open Files Code: Sub Open_all_files() 'Opens all files in folder AND Subfolders Dim FSO As Scripting.FileSystemObject Dim TopFolder As String Set FSO = New Scripting.FileSystemObject TopFolder = "C:\testfolder" '<<<<<<<<< THIS IS WHAT I WOULD LIKE TO BE VARIABLE InnerProc FSO.GetFolder(TopFolder), FSO End Sub Sub InnerProc(F As Scripting.Folder, FSO As Scripting.FileSystemObject) Dim SubFolder As Scripting.Folder Dim OneFile As Scripting.File Dim WB As Workbook For Each SubFolder In F.SubFolders If LCase(SubFolder.Name) Like "*rollup*" Then ' do nothing Else InnerProc SubFolder, FSO End If Next SubFolder For Each OneFile In F.Files Debug.Print OneFile.path If Right(OneFile.Name, 4) = ".xls" Then Set WB = Workbooks.Open(Filename:=OneFile.path) 'Do stuff here End If Next OneFile End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Merge 2 pieces of code
As long as GetDirecotry is visible to this routine
Sub Open_all_files() 'Opens all files in folder AND Subfolders Dim FSO As Scripting.FileSystemObject Dim TopFolder As String Set FSO = New Scripting.FileSystemObject msg "Select directory" TopFolder = GetDirectory(msg) if TopFolder = "" then msgbox "No selection, exiting" exit sub end if InnerProc FSO.GetFolder(TopFolder), FSO End Sub -- Regards, Tom Ogilvy "Steph" wrote in message ... Hi everyone. I have 2 separate pieces of code: 1 allows the user to browse to and select a directory. The second opens all files within a flder directory. In that piece, the folder path is predefined as a variable. I would love to make that piece dynamic to allow for the user to browse to the folder, read that folder as a variable, and apply it to the second piece of code. The code is below. Thanks for your help!! Get Directory Code: Option Explicit Public 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 '32-bit API declarations Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _ As Long Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Sub Test() Dim Msg As String Dim x As Variant Msg = "Please select a location for the backup." MsgBox GetDirectory(Msg) End Sub Function GetDirectory(Optional Msg) As String Dim bInfo As BROWSEINFO Dim path As String Dim r As Long, x As Long, pos As Integer ' Root folder = Desktop bInfo.pidlRoot = 0& ' Title in the dialog If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." Else bInfo.lpszTitle = Msg End If ' Type of directory to return bInfo.ulFlags = &H1 ' Display the dialog x = SHBrowseForFolder(bInfo) ' Parse the result path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetDirectory = Left(path, pos - 1) Else GetDirectory = "" End If End Function Open Files Code: Sub Open_all_files() 'Opens all files in folder AND Subfolders Dim FSO As Scripting.FileSystemObject Dim TopFolder As String Set FSO = New Scripting.FileSystemObject TopFolder = "C:\testfolder" '<<<<<<<<< THIS IS WHAT I WOULD LIKE TO BE VARIABLE InnerProc FSO.GetFolder(TopFolder), FSO End Sub Sub InnerProc(F As Scripting.Folder, FSO As Scripting.FileSystemObject) Dim SubFolder As Scripting.Folder Dim OneFile As Scripting.File Dim WB As Workbook For Each SubFolder In F.SubFolders If LCase(SubFolder.Name) Like "*rollup*" Then ' do nothing Else InnerProc SubFolder, FSO End If Next SubFolder For Each OneFile In F.Files Debug.Print OneFile.path If Right(OneFile.Name, 4) = ".xls" Then Set WB = Workbooks.Open(Filename:=OneFile.path) 'Do stuff here End If Next OneFile End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Merge base on same code number | Excel Worksheet Functions | |||
First zero doesn't show up in zip code mail merge. | Excel Worksheet Functions | |||
zip code with mail merge | Excel Discussion (Misc queries) | |||
Code launches Mail Merge but disables the Mail Merge | Excel Discussion (Misc queries) | |||
Merge two pieces of code into one | Excel Programming |