Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 28 of 28

Thread: Dilemma showing message box when try open file by userform

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

  2. #22
    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

  3. #23
    Administrator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,290
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2408, Build 17928.20080

  4. #24
    Administrator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,290
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2408, Build 17928.20080

  5. #25
    finally works well.
    thank you so much georgiboy .

  6. #26
    Administrator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,290
    Location
    You are welcome, see post 24 if you want to keep the count running.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2408, Build 17928.20080

  7. #27
    VBAX Contributor
    Joined
    Nov 2020
    Location
    Swansea,South Wales,UK
    Posts
    113
    Location
    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 "".

  8. #28
    thanks again georgiboy .

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •