Array/List of Lines from File

Pascal

Board Regular
Joined
Jun 6, 2007
Messages
200
Hi,

I'm after some assistance on converting some VB.Net code to VBA.

The VB.Net Code is: -

Code:
        Dim strTextLine As String
        Dim strCurrSystem As String
        Dim strLogFile As String
        Dim strLines As New List(Of String)()

        Dim intFirstPos As Integer
        Dim intLastPos As Integer
        Dim intLength As Integer

        Dim strFiles() As String = System.IO.Directory.GetFiles(strLogPath, "netLog*")

        System.Array.Sort(strFiles, New FileInfoCompare)

        If System.IO.File.Exists(strFiles(strFiles.Length - 1)) Then
            Using FS As New System.IO.FileStream(strFiles(strFiles.Length - 1), IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.ReadWrite)
                Using MyStreamReader As New System.IO.StreamReader(FS)
                    While (MyStreamReader.Peek() > -1)
                        strLines.Add(MyStreamReader.ReadLine)
                    End While
                    MyStreamReader.Close()
                End Using
            End Using
        Else
            MsgBox("File Not Found")
        End If
        Dim strLine As String

        strLines.Reverse()

        'Array.Reverse(strLines)

        For Each strLine In strLines
            strTextLine = strLine
            If strTextLine.Contains("System:") Then
                intFirstPos = InStr(1, strTextLine, "(", CompareMethod.Text)
                intLastPos = InStr(1, strTextLine, ")", CompareMethod.Text)
                intLength = intLastPos - intFirstPos
                strCurrSystem = Mid(strTextLine, intFirstPos + 1, intLength - 1)
                Exit For
            End If
        Next

I currently have the following code which gets the file that I want to read: -

Code:
Option Explicit

Dim strLogFile As String

Sub FindMe()

    Dim iFilesNum As Integer
    Dim iCount As Integer
    Dim recMyFiles() As FoundFileInfo
    Dim blFilesFound As Boolean

    blFilesFound = FindFiles("C:\Users\Andrew\AppData\Local\Frontier_Developments\Products\FORC-FDEV-D-1001\Logs", _
        recMyFiles, iFilesNum, "netLog*", False)
    If blFilesFound Then
        For iCount = 1 To iFilesNum
        Next
    Else
        MsgBox "No file(s) found matching the specified file spec.", _
            vbInformation, "File(s) not Found"
    End If
    
    With recMyFiles(iFilesNum)
        MsgBox "Path:" & vbTab & .sPath & _
            vbNewLine & "Name:" & vbTab & .sName, _
            vbInformation, "Found Files"
        strLogFile = .sPath & .sName
    End With

End Sub

Function used to read files in directory: -

Code:
Option Explicit

'*
'* Properties that will be collected for each found file
'*
Type FoundFileInfo
    sPath As String
    sName As String
End Type

Function FindFiles(ByVal sPath As String, _
    ByRef recFoundFiles() As FoundFileInfo, _
    ByRef iFilesFound As Integer, _
    Optional ByVal sFileSpec As String = "*.*", _
    Optional ByVal blIncludeSubFolders As Boolean = False) As Boolean
'
' FindFiles
' ---------
' Finds all files matching the specified file spec starting from the specified path and
' searches sub-folders if required.
'
' Parameters
' ----------
' sPath (String): Start-up folder, e.g. "C:\Users\Username\Documents"
'
' recFoundFiles (User-defined data type): a user-defined dynamic array to store the path
' and name of found files. The dimension of this array is (1 To nnn), where nnn is the
' number of found files. The elements of this array are:
'   .sPath (String) = File path
'   .sName (String) = File name
'
' iFilesFound (Integer): Number of files found.
'
' sFileSpec (String): Optional parameter with default value = "*.*"
'
' blIncludeSubFolders (Boolean): Optional parameter with default value = False
'   (which means sub-folders will not be searched)
'
' Return values
' -------------
' True: One or more files found, therefore
'   recFoundFiles = Array of paths and names of all found files
'   iFilesFound = Number of found files
' False: No files found, therefore
'   iFilesFound = 0
'
' Using the function (sample code)
' --------------------------------
'    Dim iFilesNum As Integer
'    Dim iCount As Integer
'    Dim recMyFiles() As FoundFileInfo
'    Dim blFilesFound As Boolean
'
'    blFilesFound = FindFiles("C:\Users\MBA\Desktop", _
'        recMyFiles, iFilesNum, "*.txt?", True)
'    If blFilesFound Then
'        For iCount = 1 To iFilesNum
'            With recMyFiles(iCount)
'                MsgBox "Path:" & vbTab & .sPath & _
'                    vbNewLine & "Name:" & vbTab & .sName, _
'                    vbInformation, "Found Files"
'            End With
'        Next
'    Else
'        MsgBox "No file(s) found matching the specified file spec.", _
'            vbInformation, "File(s) not Found"
'    End If
'
'
' Constructive comments and Reporting of bugs would be appreciated.
'

    Dim iCount As Integer           '* Multipurpose counter
    Dim sFileName As String         '* Found file name
    '*
    '* FileSystem objects
    Dim oFileSystem As Object, _
        oParentFolder As Object, _
        oFolder As Object, _
        oFile As Object

    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set oParentFolder = oFileSystem.GetFolder(sPath)
    If oParentFolder Is Nothing Then
        FindFiles = False
        On Error GoTo 0
        Set oParentFolder = Nothing
        Set oFileSystem = Nothing
        Exit Function
    End If
    sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\")
    '*
    '* Find files
    sFileName = Dir(sPath & sFileSpec, vbNormal)
    If sFileName <> "" Then
        For Each oFile In oParentFolder.Files
            If LCase(oFile.Name) Like LCase(sFileSpec) Then
                iCount = UBound(recFoundFiles)
                iCount = iCount + 1
                ReDim Preserve recFoundFiles(1 To iCount)
                With recFoundFiles(iCount)
                    .sPath = sPath
                    .sName = oFile.Name
                End With
            End If
        Next oFile
        Set oFile = Nothing         '* Although it is nothing
    End If
    If blIncludeSubFolders Then
        '*
        '* Select next sub-forbers
        For Each oFolder In oParentFolder.SubFolders
            FindFiles oFolder.Path, recFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders
        Next
    End If
    FindFiles = UBound(recFoundFiles) > 0
    iFilesFound = UBound(recFoundFiles)
    On Error GoTo 0
    '*
    '* Clean-up
    Set oFolder = Nothing           '* Although it is nothing
    Set oParentFolder = Nothing
    Set oFileSystem = Nothing

End Function

Now, the bit I'm struggling to find how to do in Excel VBA is the reading of the file found from the bottom up to check for a match on the line I'm after.

In the VB.Net code there is an Array "Dim strLines As New List(Of String)()" which is then Reversed for me to read from the bottom up.

How, or rather what do you suggest I do to achieve the same in VBA?

All thoughts & help appreciated.

Thanks & Regards
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Hi,

Well progress is being made, I now have the following: -

Code:
Option Explicit

Dim strLogFile As String

Sub FindMe()

    Dim iFilesNum As Integer
    Dim iCount As Integer
    Dim recMyFiles() As FoundFileInfo
    Dim blFilesFound As Boolean
    Dim arrFileLines()

    blFilesFound = FindFiles("C:\Users\Andrew\AppData\Local\Frontier_Developments\Products\FORC-FDEV-D-1001\Logs", _
        recMyFiles, iFilesNum, "netLog*", False)
    If blFilesFound Then
        For iCount = 1 To iFilesNum
        Next
    Else
        MsgBox "No file(s) found matching the specified file spec.", _
            vbInformation, "File(s) not Found"
    End If
    
    With recMyFiles(iFilesNum)
        MsgBox "Path:" & vbTab & .sPath & _
            vbNewLine & "Name:" & vbTab & .sName, _
            vbInformation, "Found Files"
        strLogFile = .sPath & .sName
    End With
    
End Sub


Sub ReadFile()
     ' Requires a reference to Microsoft Scripting Runtime (Tools > References)
    Dim FSO As FileSystemObject
    Dim FSOFile As File
    Dim FSOStream As TextStream
     
    Set FSO = New FileSystemObject
    Set FSOFile = FSO.GetFile(strLogFile)
    Set FSOStream = FSOFile.OpenAsTextStream(ForReading, TristateUseDefault)
    Do While Not FSOStream.AtEndOfStream
        Debug.Print FSOStream.ReadLine
    Loop
    FSOStream.Close
End Sub

This works and the contents of the file a output to the Immediate Window.

What I now need to do is output each line into an array and then read each line from that array backwards.

I haven't done that much with arrays, but I'm presuming I need to ReDim after each time I touch the array?

Also, how is an array handled backwards?

Thanks & Regards
 
Upvote 0
Code:
Sub M_snb()
  sn=filter(split(createobject("wscript.shell").exec("cmd /c Dir C:\Users\Andrew\AppData\Local\Frontier_Developments\Products\FORC-FDEV-D-1001\Logs\netlog* /b /s").stdout.readll,vbcrlf),".")

  with createobject("scripting.filesystemobject")
    for j=0 to ubound(sn)
      sn(j)=.opentextfile(sn(j)).readall
    next
  end with

  sheet1.cells(1).resize(ubound(sn)+1)=application.transpose(sn)
End Sub
 
Last edited:
Upvote 0
Thanks for the reply snb_,

Is there any other way?

Once the array has been populated I need to read each line in turn to check if I require information from that line, if I find a match the search is over and I don't check that rest of the file/array.

Regards
 
Upvote 0
Hi,

Well I now have the following that is reading the lines of the file into the Array: -

Code:
Sub ReadStrangeFile()
     ' Requires a reference to Microsoft Scripting Runtime (Tools > References)
    Dim FSO As FileSystemObject
    Dim FSOFile As File
    Dim FSOStream As TextStream
    Dim arrFileLines() As String
    Dim i As Integer
     
    Set FSO = New FileSystemObject
    Set FSOFile = FSO.GetFile(strLogFile)
    Set FSOStream = FSOFile.OpenAsTextStream(ForReading, TristateUseDefault)
    i = 0
    Do While Not FSOStream.AtEndOfStream
        ReDim Preserve arrFileLines(i)
        arrFileLines(i) = FSOStream.ReadLine
        i = i + 1
    Loop
    FSOStream.Close
    
    Debug.Print UBound(arrFileLines())
        
End Sub

Now that it has been populated, I'd like to start from the bottom/end of the array and work up to look for a line from the file imported that contains "System:"

Here is a sample of such a line from the file: -

19:47:31} System:11(Blau Aescs PM-L b37-11) Body:0 Pos:(1.13764e+010,7.24941e+009,-7.96476e+009) cruising

If such a line is found I then need to grab just "Blau Aescs PM-L b37-11" from it.

I don't want to start from the top as I'm always only interested in the last entry in the file of such a line, of which there will be many, the test file I'm working with currently has over 5,000 lines in it and some others over 9,000.

In VB.Net I was able to use: -

Code:
Array.Reverse()

As per this snippet of code: -

Code:
        strLines.Reverse()

        For Each strLine In strLines
            strTextLine = strLine
            If strTextLine.Contains("System:") Then
                intFirstPos = InStr(1, strTextLine, "(", CompareMethod.Text)
                intLastPos = InStr(1, strTextLine, ")", CompareMethod.Text)
                intLength = intLastPos - intFirstPos
                strCurrSystem = Mid(strTextLine, intFirstPos + 1, intLength - 1)
                Exit For
            End If
        Next

However, unfortunately this isn't available within VBA, hence trying to find another way around it.

Regards
 
Last edited:
Upvote 0
Did you even try the suggestion I gave you ??

Code:
Sub M_snb()
  sn=filter(split(createobject("wscript.shell").exec("cmd /c Dir C:\Users\Andrew\AppData\Local\Frontier_Developments\Products\FORC-FDEV-D-1001\Logs\netlog* /b /s").stdout.readall,vbcrlf),".")

  with createobject("scripting.filesystemobject")
    for j=0 to ubound(sn)
      sp=filter(split(.opentextfile(sn(j)).readall,vbcr),"System:")
      if ubound(sp)>-1 then sn(j)=split(split(split(sp(ubound(sp)),"System:")(1),"(")(1),")")(0)
    next
  end with

  sheet1.cells(1).resize(ubound(sn)+1)=application.transpose(sn)
End Sub
 
Upvote 0
Did you even try the suggestion I gave you ??

I have and it's reading every file in the directory. I did think it had hung, so left it for a while.

I'm only after the last (newest) file within the directory.
 
Upvote 0
I'm only after the last (newest) file within the directory.

That seems to be a new requirement, you could have mentioned earlier.
It makes the code much simpler.

Code:
Sub M_snb()
  c00= filter(split(createobject("wscript.shell").exec("cmd /c Dir C:\Users\Andrew\AppData\Local\Frontier_Developments\Products\FORC-FDEV-D-1001\Logs\netlog* /b /s /o-d").stdout.readall,vbcrlf)(0)

  msgbox split(split(split(createobject("scripting.filesystemobject").opentextfile(c00).readall,"System:")(1),"(")(1),")")(0)
End Sub

NB. I assume the folder you are earching in has no subfolders.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,266
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top