Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Open a pdf file code modification
I have gotten some code from Barb Reinhardt some time ago, but want to add
some more code to it. I want it to not only search that folder but all of the subfolders in that same directory. i know that the file applicationfile.search has a subdir property, but i couldn't use that solution, so barb gave me this. How do i make this code search the sub folders? Is there a property that does this? Private Sub Lbx_file_names_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ' If (Lbx_file_names.Value < "") Then ' Adobe_Filename_Pick = Lbx_file_names.Value ' End If ' If (Adobe_Filename_Pick < "") Then ' Shell "C:\Program Files (x86)\Adobe\Acrobat 9.0\Acrobat\Acrobat.exe" & _ (" " + MyFolder + Adobe_Filename_Pick), 1 '" X:\Omar\Finished_Flanges\14_600_RTJ_WN_S40.pdf", 1 ' ' the following prints the document 'Application.SendKeys "^p~", False ' End If ' End Sub Thanks, Omar |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Open a pdf file code modification
Here's some sample code that will search subfolders.
'/=============================================/ ' Sub Purpose: change from FileSearch to recursive DIR ' for 2007 comparability (Dir Recursive ' basic concept from MrExcel.com) '/=============================================/ ' Public Sub ListFilesToDebug() Dim blnSubFolders As Boolean Dim k As Long, i As Long Dim fso As Object Dim strArr() As String Dim strName As String Dim strDirectory As String Dim strFileNameFilter As String On Error Resume Next '- - - - - V A R I A B L E S - - - - - - - - strDirectory = "C:\Temp\" 'look in this folder blnSubFolders = True 'look in all sub folders if TRUE strFileNameFilter = "*.XL*" 'filter on these files '- - - - - - - - - - - - - - - - - - - - - - 'get 1st filename strName = Dir(strDirectory & strFileNameFilter) 'put filenames into array Do While strName < vbNullString k = k + 1 ReDim Preserve strArr(k) strArr(k) = strDirectory & strName strName = Dir() 'get next file name Loop 'get subfolder filenames if subfolder option selected If blnSubFolders Then Set fso = CreateObject("Scripting.FileSystemObject") Call GetSubFolderFiles(fso.GetFolder(strDirectory), _ strArr(), k, strFileNameFilter) End If 'show the results in the IMMEDIATE window For i = 1 To k Debug.Print strArr(i) & " - " & FileDateTime(strArr(i)) Next i exit_Sub: 'generic exit sub routine On Error Resume Next Exit Sub err_Sub: 'generic error message routine Debug.Print "Error: " & Err.Number & " - (" & _ Err.Description & _ ") - " & Now() GoTo exit_Sub End Sub '/=============================================/ ' Sub Purpose: recursive for filesearch 2007 '/=============================================/ ' Private Sub GetSubFolderFiles(ByRef Folder As Object, _ ByRef strArr() As String, ByRef i As Long, _ ByRef searchTerm As String) Dim SubFolder As Object Dim strName As String On Error GoTo err_Sub For Each SubFolder In Folder.SubFolders 'get 1st filename in subfolder strName = _ Dir(SubFolder.Path & Application.PathSeparator & searchTerm) 'put filenames and file info in subfolders into array Do While strName < vbNullString i = i + 1 ReDim Preserve strArr(i) strArr(i) = _ SubFolder.Path & Application.PathSeparator & strName strName = Dir() Loop Call GetSubFolderFiles(SubFolder, strArr(), i, searchTerm) Next exit_Sub: On Error Resume Next Exit Sub err_Sub: Debug.Print "Error: " & Err.Number & " - (" & _ Err.Description & _ ") - " & Now() GoTo exit_Sub End Sub '/=============================================/ -- Hope this helps. If it does, please click the Yes button. Thanks in advance for your feedback. Gary Brown "Omar" wrote: I have gotten some code from Barb Reinhardt some time ago, but want to add some more code to it. I want it to not only search that folder but all of the subfolders in that same directory. i know that the file applicationfile.search has a subdir property, but i couldn't use that solution, so barb gave me this. How do i make this code search the sub folders? Is there a property that does this? Private Sub Lbx_file_names_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ' If (Lbx_file_names.Value < "") Then ' Adobe_Filename_Pick = Lbx_file_names.Value ' End If ' If (Adobe_Filename_Pick < "") Then ' Shell "C:\Program Files (x86)\Adobe\Acrobat 9.0\Acrobat\Acrobat.exe" & _ (" " + MyFolder + Adobe_Filename_Pick), 1 '" X:\Omar\Finished_Flanges\14_600_RTJ_WN_S40.pdf", 1 ' ' the following prints the document 'Application.SendKeys "^p~", False ' End If ' End Sub Thanks, Omar |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
code modification | Excel Programming | |||
modification to this code | Excel Discussion (Misc queries) | |||
Code Modification | Excel Programming | |||
Modification in the CODE to HIDE rows and columns that start with ZERO (code given) | Excel Programming | |||
modification for the code | Excel Programming |