Dilemma showing message box when try open file by userform

[abdelfattah]

Hello,
this code should work with files are already existed in folders and sub-folders in specific device. when try open file after click from listbox on userform, but my problem if the file is already existed will show message "file not found" after open the file , shouldn't show as long the file is existed.
I'm not sure where is the problem !:banghead:


Dim i As Long

Sub ListBox1_Click()
Dim FileRoot As String
Dim objFldr As Object
Dim objFSO As Object
' initialise "found" counter
i = 0
' state target WITHOUT last \!
Const FolderPath = "C:\Users\abdd\Desktop\files"
With ListBox1
MsgBox .ListIndex & ": " & .List(.ListIndex, 2)
FileRoot = .List(.ListIndex, 2)
End With
' enable use of FSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
' get folder
Set objFldr = objFSO.GetFolder(FolderPath)
' pass folder and root to the function
LoopEachFolder objFldr, FileRoot
' quit FSO
Set objFSO = Nothing
' fit results and tell user
If i <> 0 Then
MsgBox "Launched " & i & " files"
Else
MsgBox "File not found for selection= " & FileRoot
End If
'return to this file
ThisWorkbook.Activate
End Sub


Function LoopEachFolder(fldFolder As Object, fRoot As String)
Dim objFldLoop As Object
' check for xls file in this folder
Fname = Dir(fldFolder & "\" & fRoot & ".xls*")
If Fname <> "" Then
' open file
Workbooks.Open Filename:=fldFolder & "\" & Fname
' increment the "found" counter
i = i + 1
End If
' check again for a pdf of that name
Fname = Dir(fldFolder & "\" & fRoot & ".pdf")
If Fname <> "" Then
' try to open pdf
ActiveWorkbook.FollowHyperlink fldFolder & "\" & Fname
' increment the "found" counter
i = i + 1
End If
' Then check within the subfolders in this folder...
For Each objFldLoop In fldFolder.subFolders
' run this function on each subfolder found
LoopEachFolder objFldLoop, fRoot
Next objFldLoop
End Function


I hope to find solution for this dilemma.

[Aussiebear]

Maybe this might be useful?



Option Explicit


Private objFSO As Object ' Declare FileSystemObject globally within the UserForm for efficiency


Private Sub UserForm_Initialize()
' Set a default folder path when the UserForm initializes
' This will default to the user's Desktop folder.
Me.txtFolderPath.Text = Environ("USERPROFILE") & "\Desktop"
Me.lblFileCount.Caption = "Files Found: 0" ' Reset count
Me.lstFiles.Clear ' Clear any previous list
End Sub


Private Sub cmdListFiles_Click()
Dim colFiles As New Collection ' Collection to store file paths
Dim strFolderPath As String
Dim objRootFolder As Object
Dim varFile As Variant
Me.lstFiles.Clear ' Clear the listbox before populating
Me.lblFileCount.Caption = "Searching..." ' Provide feedback to the user
strFolderPath = Trim(Me.txtFolderPath.Text)
' Initialize FileSystemObject if it hasn't been already
If objFSO Is Nothing Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
End If
' Validate the folder path
If objFSO.FolderExists(strFolderPath) Then
On Error GoTo ErrorHandler ' Enable error handling for folder access
Set objRootFolder = objFSO.GetFolder(strFolderPath)
' Call the recursive function to populate the collection with file paths
Call GetAllFiles(objRootFolder, colFiles)
' Populate the ListBox with the found file paths
For Each varFile In colFiles
Me.lstFiles.AddItem varFile
Next varFile
' Update the file count label
Me.lblFileCount.Caption = "Files Found: " & colFiles.Count & " files."
Else
MsgBox "The specified folder path does not exist. Please enter a valid path.", vbExclamation, "Invalid Folder"
Me.lblFileCount.Caption = "Files Found: 0"
End If
' Clean up the FileSystemObject when the UserForm closes or after use (optional here, as it's global to the form)
' Set objFSO = Nothing ' If you want to release it after each search
Exit Sub
ErrorHandler:
' Handle errors, e.g., permission denied to access a folder
MsgBox "An error occurred while accessing folder: " & strFolderPath & vbCrLf & _
"Error: " & Err.Description, vbCritical, "Access Error"
Me.lblFileCount.Caption = "Error during search."
On Error GoTo 0 ' Disable error handling
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' Clean up the FileSystemObject when the UserForm is closed
Set objFSO = Nothing
End Sub




' --- Code for Module1 (Standard Module) ---


' Place this code in a new standard module (e.g., Module1)


Option Explicit


' This function recursively gets all files within a given folder and its subfolders.
' It adds the full path of each file to the provided collection.
' Parameters:
' objFolder: The FileSystemObject.Folder object to process.
' colFiles: The Collection object to which file paths will be added.

Public Sub GetAllFiles(ByVal objFolder As Object, ByRef colFiles As Collection)
Dim objFile As Object
Dim objSubFolder As Object
On Error Resume Next ' Resume on error to handle inaccessible folders without stopping
' For example, System Volume Information or other protected folders.
' Add all files in the current folder to the collection
For Each objFile In objFolder.Files
colFiles.Add objFile.Path
Next objFile
' Recursively call this function for each subfolder
For Each objSubFolder In objFolder.SubFolders
Call GetAllFiles(objSubFolder, colFiles) ' Recursive call
Next objSubFolder
On Error GoTo 0 ' Re-enable normal error handling
End Sub


' This is a simple macro to display the UserForm.
' You can assign this macro to a button on your worksheet, or run it directly.

Public Sub ShowFileListForm()
frmFileList.Show
End Sub

[abdelfattah]

thanks , but doesn't work at all !:eek:
just show directory in txtFolderPath and show file found : 0 in lblFileCount !:(

[Aussiebear]

Okay, then this might be the solution;



Option Explicit


Private objFSO As Object ' Declare FileSystemObject globally within the UserForm for efficiency


Private Sub UserForm_Initialize()
' Set a default folder path when the UserForm initializes
' This will default to the user's Desktop folder.
Me.txtFolderPath.Text = Environ("USERPROFILE") & "\Desktop"
Me.lblFileCount.Caption = "Files Found: 0" ' Reset count
Me.lstFiles.Clear ' Clear any previous list
End Sub


Private Sub cmdListFiles_Click()
Dim colFiles As New Collection ' Collection to store file paths
Dim strFolderPath As String
Dim objRootFolder As Object
Dim varFile As Variant
Dim i As Long ' Counter for listbox population
Me.lstFiles.Clear ' Clear the listbox before populating
Me.lblFileCount.Caption = "Searching..." ' Provide feedback to the user
strFolderPath = Trim(Me.txtFolderPath.Text)
' Initialize FileSystemObject if it hasn't been already
If objFSO Is Nothing Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
End If
' Validate the folder path
If objFSO.FolderExists(strFolderPath) Then
' Temporarily remove On Error GoTo ErrorHandler here to allow more specific errors to show
' We will rely on the error handling within GetAllFiles for specific folder access issues.
' On Error GoTo ErrorHandler ' Re-enable if you want overall UserForm error handling
Set objRootFolder = objFSO.GetFolder(strFolderPath)
' DEBUG: Print the root folder being processed
Debug.Print "Starting file search in: " & strFolderPath
' Call the recursive function to populate the collection with file paths
Call GetAllFiles(objRootFolder, colFiles)
' DEBUG: Print the total count of files collected
Debug.Print "Total files collected into collection: " & colFiles.Count
' Populate the ListBox with the found file paths
i = 0
For Each varFile In colFiles
Me.lstFiles.AddItem varFile
i = i + 1
' Allow UI to update for large lists
If i Mod 100 = 0 Then DoEvents
Next varFile
' Update the file count label
Me.lblFileCount.Caption = "Files Found: " & colFiles.Count & " files."
Else
MsgBox "The specified folder path does not exist. Please enter a valid path.", vbExclamation, "Invalid Folder"
Me.lblFileCount.Caption = "Files Found: 0"
End If
' Clean up the FileSystemObject when the UserForm closes or after use (optional here, as it's global to the form)
' Set objFSO = Nothing ' If you want to release it after each search
Exit Sub
' ErrorHandler: ' Only active if On Error GoTo ErrorHandler is enabled above
' Handle errors, e.g., permission denied to access a folder
' MsgBox "An error occurred while accessing folder: " & strFolderPath & vbCrLf & "Error: " & Err.Description, vbCritical, "Access Error"
' Me.lblFileCount.Caption = "Error during search."
' On Error GoTo 0 ' Disable error handling
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' Clean up the FileSystemObject when the UserForm is closed
Set objFSO = Nothing
End Sub




Code for Module1 (Standard Module)


Option Explicit


' This function recursively gets all files within a given folder and its subfolders.
' It adds the full path of each file to the provided collection.
' Parameters:
' objFolder: The FileSystemObject.Folder object to process.
' colFiles: The Collection object to which file paths will be added.

Public Sub GetAllFiles(ByVal objFolder As Object, ByRef colFiles As Collection)
Dim objFile As Object
Dim objSubFolder As Object
Dim initialFileCount As Long ' For debugging
' DEBUG: Print the folder currently being processed
Debug.Print " Processing folder: " & objFolder.Path
initialFileCount = colFiles.Count ' Store count before adding files from this folder
' Use specific error handling for folder access issues
On Error GoTo FileAccessError
' Add all files in the current folder to the collection
For Each objFile In objFolder.Files
colFiles.Add objFile.Path
Next objFile
' DEBUG: Print how many files were added from this specific folder
Debug.Print " Files added from '" & objFolder.Name & "': " & (colFiles.Count - initialFileCount)
' Recursively call this function for each subfolder
For Each objSubFolder In objFolder.SubFolders
Call GetAllFiles(objSubFolder, colFiles) ' Recursive call
Next objSubFolder
On Error GoTo 0 ' Re-enable normal error handling
Exit Sub ' Exit the sub if no errors
FileAccessError:
' DEBUG: Log the error and the folder that caused it
Debug.Print " ERROR accessing folder: " & objFolder.Path & " - " & Err.Description
Resume Next ' Continue to the next item or exit the loop/function
End Sub


This is a simple macro to display the UserForm.
' You can assign this macro to a button on your worksheet, or run it directly.

Public Sub ShowFileListForm()
frmFileList.Show
End Sub


As the code runs, messages will appear in the Immediate Window. Pay close attention to:
Starting file search in: [Your Folder Path]
Processing folder: [Specific Folder Path] (for each folder scanned)
Files added from '[Folder Name]': [Number] (This tells you how many files were successfully added from each individual folder).
ERROR accessing folder: [Folder Path] - [Error Description] (If there are permission issues).
Total files collected into collection: [Final Count]
If the "Files added from" line shows 0 for all folders, and the "Total files collected" also shows 0, it's highly likely that:

Permissions: Your user account doesn't have read access to the files or folders in that directory structure. This is a common issue with system folders or network drives.
No Actual Files: Though less likely, the folders might genuinely be empty of files (they might contain only subfolders).

Please let me know what output you see in the Immediate Window. That will give us a much clearer picture of what's happening!

[abdelfattah]

the same problem, sorry!

Please let me know what output you see in the Immediate Window. That will give us a much clearer picture of what's happening!
doesn't show anything because when click row in listbox doesn't do anything
just show me zero .
here is random file.

[arnelgp]

I run your code on #1, but did not see any errors with it. It actually count how many files (excel or pdf) were launched.

[abdelfattah]

arnelgp
I didn't say there is error!
it doesn't open any file when click selected from listbox whether excel or pdf files.

[arnelgp]

arnelgp
I didn't say there is error!
it doesn't open any file when click selected from listbox whether excel or pdf files.
maybe because of this code in UserForm_Initialize() sub:


Private Sub UserForm_Initialize()
' Set a default folder path when the UserForm initializes
' This will default to the user's Desktop folder.
Me.TextBox1.Text = Environ("USERPROFILE") & "C:\Users\pc\Desktop\data"
Me.Label1.Caption = "Files Found: 0" ' Reset count
Me.ListBox1.Clear ' Clear any previous list
End Sub

If should be:


Private Sub UserForm_Initialize()
' Set a default folder path when the UserForm initializes
' This will default to the user's Desktop folder.
Me.TextBox1.Text = Environ("USERPROFILE") & "\Desktop\data"
Me.Label1.Caption = "Files Found: 0" ' Reset count
Me.ListBox1.Clear ' Clear any previous list
End Sub

[abdelfattah]

I don't think so , doesn't change anything!:(
what I notice in the code there is missed thing !
I don't see any matching the files names in column 3 in listbox with files names in folders , subfolders !:bug:

[arnelgp]

it doesn't change anything?
well try to type it on Immediate window:


?Environ("USERPROFILE") & "C:\Users\pc\Desktop\data"

will result:


C:\Users\pcC:\users\pc\Desktop\data

While:

?Environ("USERPROFILE") & "\Desktop\data"

will result:

C:\users\pc\Desktop\data

[abdelfattah]

that's correct and I noticed that.
did you read this?

what I notice in the code there is missed thing !
I don't see any matching the files names in column 3 in listbox with files names in folders , subfolders

[Aussiebear]

When you stepped through my code, what did the immediate window show you?

[abdelfattah]

will pass thought Private Sub UserForm_Activate() , Private Sub UserForm_Initialize() and stop without show anything in immediate window .

[abdelfattah]

as long there is no solution here I posted in another forum .:(
https://chandoo.org/forum/threads/dilemma-showing-message-box-when-try-open-file-by-userform.58607/

[georgiboy]

Do you have any of the below characters within your file names:

\ / : * ? " < > |

[abdelfattah]

Do you have any of the below characters within your file names:

\ / : * ? " < > |
EXCEL prohibit me to use theses characters , right?
will just contain "-" and mixed letters with numbers.

[georgiboy]

I am trying to guess at what could be going wrong. I have tested your code and it seems to function correctly my end. The only thing I can think that will cause an issue is the file names.

Is there a particular file name that is causing issues or does this happen with all of the files you open?

[Aussiebear]

Since you choose to not respond to my post #12 it hard to imagine how we can assist you any further.

Does the following code work for you?



Dim i As LongSub ListBox1_Click()
Dim FileRoot As String
Dim objFldr As Object
Dim objFSO As Object
' initialise "found" counter i = 0
' state target WITHOUT last \!
Const FolderPath As String = "C:\Users\abdd\Desktop\files"
' Use Const for better practice
With ListBox1
' Ensure ListIndex is valid before proceeding
If .ListIndex >= 0 Then
MsgBox .ListIndex & ": " & .List(.ListIndex, 2) FileRoot = .List(.ListIndex, 2)
Else
MsgBox "No item selected in ListBox."
Exit Sub
End If
End With
' enable use of FSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
' get folder
If objFSO.FolderExists(FolderPath) Then
Set objFldr = objFSO.GetFolder(FolderPath)
' pass folder and root to the function
LoopEachFolder objFldr, FileRoot
Else
MsgBox "The specified folder does not exist: " & FolderPath
End If
' quit FSO
Set objFSO = Nothing
' fit results and tell user
If i <> 0 Then
MsgBox "Launched " & i & " files"
Else
MsgBox "File not found for selection = " & FileRoot & " in " & FolderPath & " or its subfolders."
End If
'return to this file
ThisWorkbook.Activate
End Sub

Function LoopEachFolder(fldFolder As Object, fRoot As String)
Dim objFldLoop As Object
Dim Fname As String
Dim FilePath As String
' Check for xls files in this folder
Fname = Dir(fldFolder.Path & "\" & fRoot & ".xls*")
Do While Fname <> ""
FilePath = fldFolder.Path & "\" & Fname
On Error Resume
Next
' Handle potential errors during file opening
Workbooks.Open Filename:=FilePath
If Err.Number = 0 Then
i = i + 1
' increment the "found" counter only if opening succeeds
Else
Debug.Print "Error opening Excel file: " & FilePath & " (" & Err.Description & ")"
Err.Clear
End If
On Error GoTo 0
Fname = Dir
' Get next xls file
Loop
' Check for pdf files of that name in this folder
Fname = Dir(fldFolder.Path & "\" & fRoot & ".pdf")
Do While Fname <> ""
FilePath = fldFolder.Path & "\" & Fname
On Error Resume Next
' Handle potential errors during hyperlink follow
ActiveWorkbook.FollowHyperlink Address:=FilePath
If Err.Number = 0 Then
i = i + 1
' increment the "found" counter only if opening succeeds
Else
Debug.Print "Error opening PDF file: " & FilePath & " (" & Err.Description & ")" Err.Clear
End If
On Error GoTo 0
Fname = Dir
' Get next pdf file
Loop '
Then check within the subfolders in this folder...
For Each objFldLoop In fldFolder.subFolders
' run this function on each subfolder found
LoopEachFolder objFldLoop, fRoot
Next objFldLoop
End Function


Unless you can tell us on which line the code fails or what the immediate window tells you the results are then you might well be better off in another forum.

[abdelfattah]

Is there a particular file name that is causing issues or does this happen with all of the files you open?
does this happen with all of the files you open

[georgiboy]

That's what I asked you.

Does the file get opened?

[abdelfattah]

Does the file get opened?
yes after open showing message.

[abdelfattah]

Since you choose to not respond to my post #12 it hard to imagine how we can assist you any further.

I clarified what happened for me in post#13 !
compile error constant expression required in (FolderPath) word .


If objFSO.FolderExists(FolderPath) Then

[georgiboy]

Right, after some more debugging. It would seem (strangely enough) that the below line in your 'ListBox1_Click' sub was causing the issue:


i = 0


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.

Also, as I think was mentioned before, your 'UserForm_Initialize' needs to be changed to:

Private Sub UserForm_Initialize()
Me.TextBox1.Text = Environ("USERPROFILE") & "\Desktop\data"
Me.Label1.Caption = "Files Found: 0"
Me.ListBox1.Clear
End Sub


Below is the full code I tested with:

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

[georgiboy]

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

[abdelfattah]

finally works well.:thumb
thank you so much georgiboy .:)

[georgiboy]

You are welcome, see post 24 if you want to keep the count running.

[Gasman]

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 "". :(

[abdelfattah]

thanks again georgiboy .:clap: