specific data from notepads to Excel

[01's]

Hi Guys,

Hope you are dong great!
I have some 100 folders and inside each folder there is 1 notepad. Every notepad has some numbers 1 below other and then at the end of these numbers two words in a row "Mean" and "Standard deviation" something like below

Mean: 0.098; Standard deviation: 0.009

I need to capture these outputs in separate sheet for each notepad and rename that sheet with the folder name. How can I do this.

Thanks for your help.

 

[ranman256]

try this:

Public Sub ImportAllFoldersAndSubFolders(ByVal pvDir)
    Dim fso, oFolder, oSubfolder, oFile, queue As Collection
    Dim vFile, vLine, vMean, vStdD, vNew, vDir, vLastDir
    Dim iStart As Integer, iEnd As Integer
    
On Error GoTo ErrImp


Range("A1").Value = "Mean"
Range("B1").Value = "StdDev"
Range("C1").Value = "file"
Range("A2").Select
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder(pvDir) 'obviously replace


    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1
        
            For Each oFile In oFolder.Files
                              '...insert any file processing code here...
                If InStr(oFile.Name, ".txt") > 0 Then
                   'Debug.Print oFile.Name, oFolder
                   vDir = oFolder & "\"
                   vFile = vDir & oFile.Name
                   Open vFile For Input As #1 
                    While Not EOF(1)
                       Line Input #1 , vLine
                    Wend
                    Debug.Print vLine, vFile
                   Close 1
                    
                    iStart = InStr(vLine, ":") + 1
                    iEnd = InStr(vLine, ";") - 1
                    vMean = Mid(vLine, iStart, iEnd - iStart)
                    
                    vLine = Mid(vLine, iEnd + 2)
                    iStart = InStr(vLine, ":") + 1
                    vStdD = Mid(vLine, iStart + 1)
                   
                      'prepare new name for the file
                   vLastDir = Mid(oFolder, InStrRev(oFolder, "") + 1)
                   vNew = vDir & vLastDir & ".txt"
                       
                       'post the results
                   ActiveCell.Offset(0, 0).Value = vMean
                   ActiveCell.Offset(0, 1).Value = vStdD
                   ActiveCell.Offset(0, 2).Value = vNew
                   ActiveCell.Offset(1, 0).Select   'next fee row
                   
                       'change the filename
                   On Error Resume Next
                     Name vFile As vNew
                   On Error GoTo ErrImp


                End If
            Next oFile
        
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder
            'Debug.Print oSubfolder
        Next oSubfolder
    Loop
    
Set fso = Nothing
Set oFolder = Nothing
Set oSubfolder = Nothing
Set oFile = Nothing
Set queue = Nothing
Exit Sub


ErrImp:
MsgBox Err.Description, , Err
End Sub

 

[01's]

Thanks ranman256,

I modified few things and it worked for my current requirements. Thanks again!