• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 167
  • Last Modified:

text info gathering

I am looking for an excel macro that will accept a folder as a parameter (it can be hard-coded within the script), it will perform the following:
-------------------------------
1. Recursively open each subfolder, including the current folder
2. In each opened folder, open each *.txt file
3. For each *.txt file do:
            a. List the name of the txt file (without the file extension) in column A
            b. list the first 200 characters from the txt file in column B
-----------------------------
In summary, the script above will generate a spreadsheet with as many records as there are text files in the directory tree, each record will identify a file name and first 200 characters of each file.

Thank you, experts!
0
cyber-33
Asked:
cyber-33
  • 6
  • 4
  • 2
1 Solution
 
Dan CraciunIT ConsultantCommented:
Here's a Powershell solution.
The script will create a csv file with 2 columns that you can open in Excel.
#get file names and first 200 characters
#script created for E-E, Q_28404384 
#it requires Powershell v3 (uses PSCustomObject)

$path = "X:\path\to\folder"
$csvFile = "X:\path\to\files.csv"

#test if the csv file exists. If it does, empty it, if it doesn't, create it
if(Test-Path $csvFile) { Clear-Content $csvFile }
else {New-Item $csvFile -ItemType file}

#get all text files
gci $path -recurse -filter "*.txt" | %{
    
    #get the first 200 characters from file. Ugly, but working. Encoding dependant
    $content = [char[]](Get-Content $_.FullName -Encoding byte -TotalCount 200) -join ''
    
    #delete the .txt part
    $name = $_.FullName.replace(".txt", "")

    #export the name and content to the csv file
    [PSCustomObject][ordered]@{Name=$name; Content=$content} | Export-Csv $csvFile -Append -NoTypeInformation
} 

Open in new window

Replace "X:\path\to\folder" and "X:\path\to\files.csv" with your data.

HTH,
Dan
0
 
cyber-33Author Commented:
Unfortunately, I don't have access to PowerShell. Any way to rewrite this to be used as a VB Excel Macro?
0
 
Dan CraciunIT ConsultantCommented:
Yes, but not my field. You'll have to wait to the VBA experts.

What OS are you using? PS comes bundled with Windows 7 and onward.
Just click Start, type run, type powershell in the run box. You might be amazed :)
0
Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

 
cyber-33Author Commented:
The problem is PowerShell scripts are disabled on my system as a matter of security.
0
 
Dan CraciunIT ConsultantCommented:
If you can open a powershell console, you can just paste the code (all at once, not line by line) and it will run, regardless of your ExecutionPolicy.
0
 
cyber-33Author Commented:
Got an error:

PS C:\Users\admin> else {New-Item $csvFile -ItemType file}
The term 'else' is not recognized as the name of a cmdlet, function, script file, or operable program. Check the spelli
ng of the name, or if a path was included, verify that the path is correct and try again.
At line:1 char:5
+ else <<<<  {New-Item $csvFile -ItemType file}
    + CategoryInfo          : ObjectNotFound: (else:String) [], CommandNotFoundException
    + FullyQualifiedErrorId : CommandNotFoundException
0
 
Ejgil HedegaardCommented:
Try this VBA function, in the file

Option Explicit
Dim strTopDir As String, strDirNow As String
Dim strDirName As String, strFileName As String
Dim lngDirRow As Long, lngRowNow As Long
Dim lngRow As Long, lngMaxRow As Long
Dim strText As String, strInputText As String
Dim wsDirList As Worksheet, wsFileList As Worksheet


Sub TxtFileList()

    Set wsDirList = Worksheets("Dirlist")
    Set wsFileList = Worksheets("Filelist")
    
    strTopDir = SelectFolder("Select Folder")
    If strTopDir = vbNullString Then
        MsgBox "No Folder Selected, Program Stop"
        End
    End If
    strTopDir = strTopDir + "\"
    
    wsDirList.Cells.ClearContents
    wsDirList.Cells(1, 1) = "Level"
    wsDirList.Cells(1, 2) = "Folder"
    
    lngRowNow = 2
    strDirName = Dir(strTopDir, vbDirectory)
    Do While strDirName <> ""
        If strDirName <> "." And strDirName <> ".." Then
            If (GetAttr(strTopDir & strDirName) And vbDirectory) = vbDirectory Then
                wsDirList.Cells(lngRowNow, 1) = 1
                wsDirList.Cells(lngRowNow, 2) = strDirName
                lngRowNow = lngRowNow + 1
            End If
        End If
        strDirName = Dir
    Loop
    
    lngRow = 2
    Do
        strDirNow = strTopDir + wsDirList.Cells(lngRow, 2) + "\"
        strDirName = Dir(strDirNow, vbDirectory)
        Do While strDirName <> ""
            If strDirName <> "." And strDirName <> ".." Then
                If (GetAttr(strDirNow & strDirName) And vbDirectory) = vbDirectory Then
                    wsDirList.Cells(lngRowNow, 1) = wsDirList.Cells(lngRow, 1) + 1
                    wsDirList.Cells(lngRowNow, 2) = wsDirList.Cells(lngRow, 2) + "\" + strDirName
                    lngRowNow = lngRowNow + 1
                End If
            End If
            strDirName = Dir
        Loop
        lngRow = lngRow + 1
    Loop While lngRow < lngRowNow
    lngMaxRow = lngRow - 1
    
    wsFileList.Select
    wsFileList.Cells.ClearContents
    lngRowNow = 2
    wsFileList.Cells(1, 1) = "Filname"
    wsFileList.Cells(1, 2) = "First 200 Characters"
    
        strDirNow = strTopDir
        strDirName = Dir(strDirNow + "*.txt")
        Do While strDirName <> ""
            If strDirName <> "." And strDirName <> ".." Then
                wsFileList.Cells(lngRowNow, 1) = Left(strDirName, Len(strDirName) - 4)
                strText = ""
                Open strDirNow + "\" + strDirName For Input As #1
                    Do
                        Line Input #1, strInputText
                        strText = strText + strInputText
                        If Len(strText) > 200 Then
                            wsFileList.Cells(lngRowNow, 2) = Left(strText, 200)
                        End If
                    Loop Until EOF(1) Or Len(strText) > 200
                Close #1
                If Len(strText) <= 200 Then
                    wsFileList.Cells(lngRowNow, 2) = strText
                End If
                lngRowNow = lngRowNow + 1
            End If
            strDirName = Dir
        Loop
    
    
    For lngDirRow = 2 To lngMaxRow
        strDirNow = strTopDir + wsDirList.Cells(lngDirRow, 2) + "\"
        strDirName = Dir(strDirNow + "*.txt")
        Do While strDirName <> ""
            If strDirName <> "." And strDirName <> ".." Then
                wsFileList.Cells(lngRowNow, 1) = Left(strDirName, Len(strDirName) - 4)
                strText = ""
                Open strDirNow + "\" + strDirName For Input As #1
                    Do
                        Line Input #1, strInputText
                        strText = strText + strInputText
                        If Len(strText) > 200 Then
                            wsFileList.Cells(lngRowNow, 2) = Left(strText, 200)
                        End If
                    Loop Until EOF(1) Or Len(strText) > 200
                Close #1
                If Len(strText) <= 200 Then
                    wsFileList.Cells(lngRowNow, 2) = strText
                End If
                lngRowNow = lngRowNow + 1
            End If
            strDirName = Dir
        Loop
    Next lngDirRow
End Sub

Function SelectFolder(Title As String, _
        Optional InitialFolder As String = vbNullString, _
        Optional InitialView As Office.MsoFileDialogView = _
            msoFileDialogViewList) As String
    Dim V As Variant
    Dim InitFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = Title
        .InitialView = InitialView
        If Len(InitialFolder) > 0 Then
            If Dir(InitialFolder, vbDirectory) <> vbNullString Then
                InitFolder = InitialFolder
                If Right(InitFolder, 1) <> "\" Then
                    InitFolder = InitFolder & "\"
                End If
                .InitialFileName = InitFolder
            End If
        End If
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            V = vbNullString
        End If
    End With
    SelectFolder = CStr(V)
End Function

Open in new window

TxtFileList.xlsm
0
 
Dan CraciunIT ConsultantCommented:
You pasted line by line :)

Select all, then paste in the PS window, then press enter.
0
 
cyber-33Author Commented:
Dan -  I did select all and then pasted all by using the right mouse button click.
0
 
cyber-33Author Commented:
HGHOLT - does your solution work only with 2 levels of the tree? My tree can have many layers, hence there was a requirement for recursion....
0
 
Ejgil HedegaardCommented:
It will include all subfolders.
The sheet DirList list all subfolders, but not the topfolder.
Press the button and select the topfolder when asked.
Foldername (path) is not in the filelist, as this was your specific requirement.
0
 
cyber-33Author Commented:
Works like a charm! Thank you!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 6
  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now