Option Explicit

Private Sub cmdFindData_Click()
    Dim strFile As String
    Dim strInput As String
    Dim myArray() As Variant, n As String
    Dim hFile As String
    Dim intI As Integer
    Dim lngPos1 As Integer
    Dim st_file As Integer
    Dim MyName As String
    Dim Fname As String
    Dim MyPath As String
    Dim MyPath2 As String
    Dim ii As Long


Dim ArrName As Variant
 Columns( 1 ).ClearContents
    
    With Application.FileSearch
        .NewSearch
        .LookIn = ThisWorkbook.Path & "\"
        '.SearchSubFolders = True
        .Filename = "*.txt"
        If .Execute >  0  Then
            For ii =  1  To .FoundFiles.Count
                ArrName = Split(.FoundFiles(ii), "\")
                
                lngPos1 = InStr( 1 , ArrName(UBound(ArrName)), ".") 
                Fname = Mid(ArrName(UBound(ArrName)),  1 , lngPos1 -  1 )
                ActiveSheet.Range("A" & ii +  1 ).End(xlUp).Offset( 1 ) = Fname
            Next ii
        Else
            MsgBox "There were no files found."
        End If
    End With

With Application.FileSearch
        .NewSearch
        '.SearchSubFolders = True
        .Filename = "*.txt"
If .Execute >  0  Then
For st_file =  2  To .FoundFiles.Count +  1 

    If Not IsEmpty(Cells(st_file,  1 )) Then
        strFile = fnFixPath(ThisWorkbook.Path) _
          & CStr(Cells(st_file,  1 )) & ".txt"
        
        If fnFileExists(strFile) Then
          hFile = FreeFile
            Open strFile For Input Access Read As hFile
            
            n =  1 
            Do Until EOF(hFile)
                Line Input #hFile, strInput
               intI = intI +  1 
               ReDim Preserve myArray(n) As Variant
               myArray(n) = strInput
               If Trim(myArray(n -  1 )) = "Salon:" And Trim(myArray(n)) = "Service:" Then
                  intI = intI +  1 
               
                  Cells(st_file, intI) = fnExtractData(strInput, True)
               Else
                    Cells(st_file, intI +  1 ) = fnExtractData(strInput, True)
               End If
               n = n +  1 
            Loop
                intI =  0 
            Close hFile
        Else
            MsgBox ("No file for...!")
        End If
    Else
        MsgBox ("No number!")
    End If
Next st_file

End If
End With
End Sub

Function fnExtractData( _
  strData As String, _
  Optional fHeader As Boolean = False) As String
    Dim lngPos As Long
    'Dim PosColum As Boolean
    
    
    lngPos = InStr( 1 , strData, ":")     
    If lngPos =  0  Then 
        If Not fHeader Then
            fnExtractData = RTrim(Mid(strData,  1 , lngPos -  1 ))
             
        Else
            fnExtractData = LTrim(Mid(strData, lngPos +  2 ))
            'PosColum = False
        End If
    Else
        If Not fHeader Then
            fnExtractData = RTrim(Mid(strData,  1 , lngPos -  1 ))
             
        Else
            fnExtractData = LTrim(Mid(strData, lngPos +  2 ))
        End If
    
    End If
End Function