yes after open showing message.Does the file get opened?
yes after open showing message.Does the file get opened?
I clarified what happened for me in post#13 !Since you choose to not respond to my post #12 it hard to imagine how we can assist you any further.
compile error constant expression required in (FolderPath) word .
If objFSO.FolderExists(FolderPath) Then
Right, after some more debugging. It would seem (strangely enough) that the below line in your 'ListBox1_Click' sub was causing the issue:
When that part of the code remains, the 'LoopEachFolder' function clears the value of i when it loops. I have removed that line and it functions correctly.i = 0
Also, as I think was mentioned before, your 'UserForm_Initialize' needs to be changed to:
Below is the full code I tested with:Private Sub UserForm_Initialize() Me.TextBox1.Text = Environ("USERPROFILE") & "\Desktop\data" Me.Label1.Caption = "Files Found: 0" Me.ListBox1.Clear End Sub
Dim i As Long Private Sub UserForm_Activate() Dim LastRow As Long LastRow = Range("A" & Rows.Count).End(xlUp).Row With ListBox1 .ColumnCount = 4 .ColumnWidths = "60;80;140;70" .List = Range("A1:D" & LastRow).Value End With End Sub Private Sub UserForm_Initialize() Me.TextBox1.Text = Environ("USERPROFILE") & "\Desktop\data" Me.Label1.Caption = "Files Found: 0" Me.ListBox1.Clear End Sub Sub ListBox1_Click() Dim FileRoot As String Dim FolderPath As String Dim objFldr As Object Dim objFSO As Object Me.Label1.Caption = "Searching..." FolderPath = Trim(Me.TextBox1.Text) With ListBox1 MsgBox .ListIndex & ": " & .List(.ListIndex, 2) FileRoot = .List(.ListIndex, 2) End With Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFldr = objFSO.GetFolder(FolderPath) LoopEachFolder objFldr, FileRoot Set objFSO = Nothing If i <> 0 Then MsgBox "Launched " & i & " files" Else MsgBox "File not found for selection= " & FileRoot End If ThisWorkbook.Activate End Sub Function LoopEachFolder(fldFolder As Object, fRoot As String) Dim objFldLoop As Object Dim Fname As String Fname = Dir(fldFolder & "\" & fRoot & ".xls*") If Fname <> "" Then Workbooks.Open Filename:=fldFolder & "\" & Fname i = i + 1 End If Fname = Dir(fldFolder & "\" & fRoot & ".pdf") If Fname <> "" Then ActiveWorkbook.FollowHyperlink fldFolder & "\" & Fname i = i + 1 End If For Each objFldLoop In fldFolder.SubFolders LoopEachFolder objFldLoop, fRoot Next objFldLoop End Function
If you wanted to keep the count running, i.e. open one file (that exists) the count of opened files is one, open a file that does not exist, you get the error stating that the file was not found, open a third file (that exists), you will get the count of two files opened. Then the below will do it, it could be improved but I am out of time...
Dim i As Long Dim x As Long Dim t As Long Private Sub UserForm_Activate() Dim LastRow As Long LastRow = Range("A" & Rows.Count).End(xlUp).Row With ListBox1 .ColumnCount = 4 .ColumnWidths = "60;80;140;70" .List = Range("A1:D" & LastRow).Value End With End Sub Private Sub UserForm_Initialize() Me.TextBox1.Text = Environ("USERPROFILE") & "\Desktop\data" Me.Label1.Caption = "Files Found: 0" Me.ListBox1.Clear End Sub Sub ListBox1_Click() Dim FileRoot As String Dim FolderPath As String Dim objFldr As Object Dim objFSO As Object Me.Label1.Caption = "Searching..." FolderPath = Trim(Me.TextBox1.Text) With ListBox1 MsgBox .ListIndex & ": " & .List(.ListIndex, 2) FileRoot = .List(.ListIndex, 2) End With Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFldr = objFSO.GetFolder(FolderPath) x = 0 LoopEachFolder objFldr, FileRoot Set objFSO = Nothing If i <> 0 Then MsgBox "Launched " & t + i & " files" Else MsgBox "File not found for selection= " & FileRoot End If ThisWorkbook.Activate End Sub Function LoopEachFolder(fldFolder As Object, fRoot As String) Dim objFldLoop As Object Dim Fname As String Fname = Dir(fldFolder & "\" & fRoot & ".xls*") If Fname <> "" Then Workbooks.Open Filename:=fldFolder & "\" & Fname i = i + 1 x = x + 1 End If Fname = Dir(fldFolder & "\" & fRoot & ".pdf") If Fname <> "" Then ActiveWorkbook.FollowHyperlink fldFolder & "\" & Fname i = i + 1 x = x + 1 End If For Each objFldLoop In fldFolder.SubFolders LoopEachFolder objFldLoop, fRoot Next objFldLoop If i > 0 And x = 0 Then t = t + i i = 0 End If End Function
finally works well.
thank you so much georgiboy .![]()
Why not just walk your code and see what it does, not what you think it does.
Your code as it stands with amended folder for my system found nothing? Fname was always "".![]()
thanks again georgiboy .![]()