Text File - using file size in VBA

[starfalls]

Hans,,,
You made me code in the MSDN VBA Forum to select files using filepicker then pulled the record into spreadsheet. The program works GREAT!!!! but i have discovered a small quirk. All the files are not the same dataset in the record so coolum A might be Foo then the next time Bug. Information is the same as long as the file size is the same. How do I fix this. This is not the whole thing but hopefully enough for you to help. I can provide more if needed. What happened to VBA Fourms ? the new format is really bad.

Code: Select all

With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.clear
    .Filters.Add "Text Files", "*.txt"
    .Title = "Select Required Files"
    .AllowMultiSelect = True
    .InitialFileName = FolderChooser & "*_chr.*"
    If .Show Then
        Set arrFiles = .SelectedItems
    Else
        MsgBox "No File Was Selected.", vbExclamation
        Exit Sub
    End If
End With
f = FreeFile
'//////////////////////////////////////////
'Get the Header Information
'//////////////////////////////////////////
Open arrFiles.Item(1) For Input As #f ' Open 1st _chr file and get Header Information to put on Wrksht
    Line Input #f, strLine ' skip past the first line of the file
    c = c + 1 'set row to cnt to position cell
Do While Not EOF(f)
    Line Input #f, strLine
    If strLine = "END" Then
                Exit Do
            End If
    arrParts = Split(strLine, vbTab)
    strPartA = arrParts(2) ' 3rd part
    strPartC = arrParts(6) 'Nominal
    strPartD = arrParts(7) 'High Tol
    strPartE = arrParts(8) ' Lower Tol
    Sheet1.Cells(r, c) = strPartA
    Sheet1.Cells(r + 1, c) = strPartC
    Sheet1.Cells(r + 2, c) = Left(strPartE, 6) & "/" & Left(strPartD, 6)
    Range(Cells(r, c), Cells(r + 2, c)).Borders.LineStyle = xlContinuous
    c = c + 1
    Loop 'loop thru to get all headers
Close #f
\\\\\\\\\
For Each varFile In arrFiles
    'reposition the active cell
    r = r + 1
    '//////////////////////////
    'Change from _chr file to _hdr file to get HDR infomation
    '//////////////////////////
    'open _hdr file
    Open Replace(varFile, "_chr.txt", "_hdr.txt") For Input As #f
    'Read _hdr file
    Line Input #f, strLine 'skip 1st record
    Line Input #f, strLine
    arrParts = Split(strLine, vbTab)
        HDR = arrParts(38) ' 38st part of HDR file to save in variable HDR
        DDR = arrParts(4) ' get the date
        TDR = arrParts(6)
    Close #f
    'open _chr file
    Open varFile For Input As #f
    Line Input #f, strLine 'skip 1st record
    'add the HDR information
    c = 1
    Sheet1.Cells(r, c) = DDR & "  " & TDR
    Sheet1.Cells(r, c + 1) = HDR
    'Sheet1.Cells(r, c + xlendleft + 1) = Right(HDR, 2)
    'Line Input #f, strLine 'skip 1st record

'    ...
'        ...
' Loop through the rest
'r = 2
c = 2
'cnt = 1
        Do While Not EOF(f)
            
            ' Read a line
            Line Input #f, strLine
            ' Get out if we reached END
            If strLine = "END" Then
                Sheet1.Cells(r, c + xlendleft + 1) = Right(HDR, 2)
                c = 3
                'r = r + 1
                Exit Do
            End If
            ' Move to next column
            c = c + 1
            ' Enter filename in column A
            'Sheet1.Cells(r, c) = strFilename
            ' Split line
            arrParts = Split(strLine, vbTab)
            'strPartA = arrParts(2) ' 3rd part
            strPartB = arrParts(5) ' 6th part
            strPartA = arrParts(10)
            If strPartA <> "" Then
                Sheet1.Cells(r, c).Interior.Color = vbYellow
            End If
            ' Do something with these parts
            'Sheet1.Cells(r, c) = strPartA
            Sheet1.Cells(r, c) = strPartB
            '...
        Loop
        Close #f

[HansV]

Welcome to Eileen's Lounge!

I don't think anyone outside Microsoft likes the new format of the MSDN/Technet forums; it has become much more difficult to find your way in them...

Perhaps we should read the header file for each data file instead of only the first header file?

[starfalls]

Hans,
I have noticed that all files with the same size have the same header information and format. Knowing this, I would like to be able for the code to keep up with all vrtselected and put each file size on seperate TABs. I know this woudl be a major change because a new TAB would require adding the header then the record.
I as well, considering one sheet and the program would find the var number and put that information in that cell. Problem is making sure the first header is the correct full header.
I even think keeping the Master Header on the spreadsheet on a sperate hidden TAB the the program would read. then use that to place the record set into the proper cell.

Your thoughts please.

[HansV]

Wouldn't it be easier to use a separate folder for all files with a specific header structure? It would then be possible to process all files in such a folder.

[starfalls]

This is for CMM Machines (3 of them) each machine has its own folder out on the server. These CMM take measurements of parts sending the results out as a text file. The CMM has specific programs (our file names) that measure specific parts. Two of the CMM machines share the work load so depending on the demand measurements could be split between the two one day then by just one the next day. Each CMM has a specility program that only certain parts can be measured by that CMM. On an average day a part is measured 8 times durning the day. If a measurement is out of specification, just that problem measurement is rerun (seperate file). So you could have 8 file with 48K size and 1 with 5K size. There in is my problem. Each file will have the part number as the first part of the file name with a job number usually a 4 digit number.
As you can see, the 8 files of the same size will have the same header but different recordsets and the small one will only have the header of that measurement and that recordset. So, for the 8 simply reading the first header and then skipping the header is okay and works great, but the quirk comes alone with just a part of the header. Second part of problem is timing of when the smaller file is run from the other larger same size files.
Programming I would pull all the files in like we are doing now but add checking the file size and grouping the files then inserting into the spreadsheet.

[HansV]

I don't think this will be easy, but I'd need to see a small but relevant set of the files (including files with different sizes).

[starfalls]

Something relating to this i am working on. I want to determine the filesize so i can put files in different tabs. In testing I used the following adding jimvar

For Each varFile In arrFiles
'reposition the active cell
r = r + 1
'//////////////////////////
'Change from _chr file to _hdr file to get HDR infomation
'//////////////////////////
'open _hdr file
jimvar = varFile
Open Replace(varFile, "_chr.txt", "_hdr.txt") For Input As #f
'Read _hdr file
Line Input #f, strLine 'skip 1st record
Line Input #f, strLine
arrParts = Split(strLine, vbTab)
HDR = arrParts(38) ' 38st part of HDR file to save in variable HDR
DDR = arrParts(4) ' get the date
TDR = arrParts(6)
Close #f
'open _chr file
Open varFile For Input As #f
Line Input #f, strLine 'skip 1st record
'add the HDR information
c = 1
Sheet1.Cells(r, c) = DDR & " " & TDR & " " & FileLen(jimvar)
Sheet1.Cells(r, c + 1) = HDR

My problem is it will not put the file size in A1 if the file is =< 10K. How does that work? I tested on 11K and 10K files and 11K would be put in A1 and 10K would not. Ideas???

[HansV]

I have no idea. FileLen should work correctly for large files too; I tested it just now with a file of 3968 KB to make sure.