VBA code to import specific data from multiple .txt files into excel data table

I have multiple .txt files (usually between 3 and 17 per day) that have specific data needed to fill an excel table. These files are currently copied to a common folder, and is "formatted" as shown in the second tab of the excel file. An example .txt file and the table (with example data) is attached. Ideally, I'd like a VBA macro to do this.

This topic was initially discussed at the bottom of http:/Q_28260763.html, where code was suggested and I was advised to open a new question to handle the specific data. <<this paragraph added on 9 March 2015 by byundt>>
Table.xlsx
02190019.TXT
dsmcl71Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

aikimarkCommented:
are you aware that your subtotals are not correct?
0
Zack BarresseCEOCommented:
Hi there,

It's unclear the entire picture of what you're trying to do with the text files, or rather more pointedly the process used to import the data. The header information I get, i.e. supplier subtotal, name, start, end, and description. But the other data it looks like you've lumped into two primary categories, and please correct me where I'm wrong because this is where it starts getting a little foggy for me. The two categories are:

Dozens
Weight

From there you have it broken down into several other categories:

OW
800
700+
700-
55
50
43
Other
Crack
Dirt
Leaker
Blood
HandCount

The problem is this structure isn't necessarily aligned with how your text file is. There are multiple data tables in your text file (three individual tables with the above elements). Are we to assume the data table in your Excel file is an aggregation of all these tables from the text file? Should it only get the first table in the text file? Should each table get put into its own new row in the Excel table?

Also there is the issue of re-importing previous data. I'm assuming you only want this data imported once from a text file, is that correct? If so, since you will have all of your text files from a single starting folder named "formatted", once each file is processed I'd recommend those files be moved to another folder as to not re-import them again, for example a "completed" folder or other such named folder which you would know what they are.

I'm not sure I understand the note in the Excel file on the '02190019' sheet where you say:

These show dozens and singles (i.e. count out of 12)
Ideally need to be separated in table.

If they should be separated in the table, please give some examples of how this should be done exactly.

Finally we need to know which version of Excel you are using, the operating system, and how exactly you want to fire this off (i.e. button on the worksheet, ribbon button, etc.). We can just write the routine obviously, but if you need more than that you need to specify this explicitly please.

Regards,
Zack Barresse
0
dsmcl71Author Commented:
Hi,

Yes the subtotals are "incorrect" in the sense that the first part of the number is a dozen count (i.e. multiply by 12 for an individual count) and the second part of the number is a "singles" count (i.e. part of a dozen e.g. 8 out of 12, or 3 out of 12). So the totals do not add up as "normal" and need separating. My current process is to use a macro that basically follows these steps:
1) Find and open necessary text files (in common folder)
2) "Format" text file excel so it is "readable" in excel (as per second tab in attached excel file).
3) Combine the converted text files into a single excel workbook.

I then manually copy/paste the necessary data into the Excel table and separate the "dozens" and "singles" with a =(left... or = (right... formula in another table, linked to the copy/pasted data.

Zack, you are correct that all the text file tables are not required. The second table, showing the Grades, Number and Weights is the main table required. The last table, showing OffGrade, Number and Weight (Crack, Dirty, Leaker, blood etc) is also required and is part of the same batch. Each text file is a batch run and the tables show the breakdown of "good quality product", separated by the size categories and "poor product quality", separated by reason for poor quality. See the two snipped images for location of this data.

Each row in the excel table is the data from each individual text file. The structure in all the .txt files is "repeatable" as in it is in the same place in every text file.

Let me know if you have further questions or need more information.
GoodQualityProductCount.JPG
PoorQualityProductCount.JPG
0
Cloud Class® Course: Amazon Web Services - Basic

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

dsmcl71Author Commented:
Zack,

To answer your last lot of questions:
1) I'm using Excel 2010 and Windows 7, but other users of this data will be using earlier versions.
2) I would like the routine as a button in the "consolidated" data table file.
3) I do not want to import the same text files repeatedly and your idea of moving the "used" files to another "completed" folder is great.

Thanks again.
0
aikimarkCommented:
Thanks.

One more question: Is the Other data taken from the first blank (name) row after the 43 row or is some other algorithm/criteria/mapping used?
0
dsmcl71Author Commented:
The "Other" is taken from cell B37 (dozens) and cell C37 (weight) on sheet 02190019 - it is count/weight data not allocated to any of the specified grade categories, but needs to be counted in the total for the batch.
0
aikimarkCommented:
Place this code into a module in a macro-enabled workbook and run the Q_28631627 macro.

Note: change the cPath string literal to point to the directory where you will have your text files.
Option Explicit

Sub ParseAndPlaceData(parmFileData As String)
    Dim oRE As Object
    Dim oMatches As Object
    Dim oM As Object
    Dim oSM As Object
    Dim lngM As Long
    Dim lngSM As Long
    Dim dicData As Object
    Dim vMapping As Variant
    Dim vItem As Variant
    Dim dicColMapping As Object
    Dim wks As Worksheet
    Dim rng As Range
    Dim boolUseFirstKeyValue As Boolean
    
    Set dicColMapping = CreateObject("scripting.dictionary")
    Set dicData = CreateObject("scripting.dictionary")
    vMapping = Array(Array("header", "^(?:.|\n)*?Ticket"), Array("grade", "Difference(?:.|\n)*?Subtotal"), _
                    Array("offgrade", "Offgrade(?:.|\n)*?\nSubtotal"), Array("handcount", "Handcount\s+1 .*"))
    
    Set oRE = CreateObject("vbscript.regexp")
    oRE.Global = True
    
    For Each vItem In vMapping
        oRE.Pattern = vItem(1)
    
        If oRE.test(parmFileData) Then
            Set oMatches = oRE.Execute(parmFileData)
            dicData(vItem(0)) = oMatches(0)
        End If
    
    Next
    Set wks = Worksheets("Data")
    Set rng = wks.Cells(wks.Rows.Count, 2).End(xlUp).Offset(1, -1)
    vMapping = Array(Array("header", "Supplier subtotal\s+:\s+([^\r]*)\s*Name\s+:\s+([^\r]*)(?:.|\n)*Start\s+:.*?(\d\d:\d\d:\d\d)\r\n(?:.|\n)*End\s+:.*?(\d\d:\d\d:\d\d)\r\n(?:.|\n)*?Description\s+:\s*?([^\r]*)\r\n", Array(2, 3, 5, 6, 4)), _
                    Array("grade", "\n(OW|800|700\+|700-|55|50|43|)\s+(\d[^ ]*\s+\d[^ ]*)\s+(\d[^ ]*)"), _
                    Array("offgrade", "\s+(\d[^ ]*\s+\d[^ ]*)\s+(\d[^ ]*)", Array(Array(15, 28), Array(16, 29), Array(17, 30), Array(18, 31))), _
                    Array("handcount", "Handcount\s+1\s+(\d[^ ]*\s+\d[^ ]*)\s+(\d[^ ]*)", Array(Array(19, 32))))
    dicColMapping("OW") = Array(7, 20)
    dicColMapping("800") = Array(8, 21)
    dicColMapping("700+") = Array(9, 22)
    dicColMapping("700-") = Array(10, 23)
    dicColMapping("55") = Array(11, 24)
    dicColMapping("50") = Array(12, 25)
    dicColMapping("43") = Array(13, 26)
    dicColMapping("") = Array(14, 27)
    For Each vItem In vMapping
        Select Case vItem(0)
            Case "grade"
                boolUseFirstKeyValue = True
            Case Else
                boolUseFirstKeyValue = False
        End Select
        If dicData.exists(vItem(0)) Then
            oRE.Pattern = vItem(1)
        
            If oRE.test(dicData(vItem(0))) Then
                Set oMatches = oRE.Execute(dicData(vItem(0)))
                lngM = 0
                For Each oM In oMatches
                    With oM
                        If IsArray(vItem(UBound(vItem))) Then
                            Select Case vItem(0)
                                Case "offgrade", "handcount"
                                    For lngSM = 0 To .submatches.Count - 1
                                        rng.Cells(1, vItem(UBound(vItem))(lngM)(lngSM)).Value = .submatches(lngSM)
                                    Next
                                Case Else
                                    For lngSM = 0 To .submatches.Count - 1
                                        rng.Cells(1, vItem(UBound(vItem))(lngSM)).Value = .submatches(lngSM)
                                    Next
                            End Select
                            
                        Else
                            For lngSM = 1 To .submatches.Count - 1
                                If dicColMapping.exists(.submatches(0)) Then
                                    rng.Cells(1, dicColMapping(.submatches(0))(lngSM - 1)).Value = .submatches(lngSM)
                                End If
                            Next
                        End If
                        
                        If boolUseFirstKeyValue Then
                            If dicColMapping.exists(.submatches(0)) Then
                                dicColMapping.Remove .submatches(0)
                            End If
                        End If
                    
                    End With
                    lngM = lngM + 1
                Next

            End If
        End If
    Next

End Sub

Sub Q_28631627()
    Dim oFS, oTS, oFile
    Dim strFileData As String
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Const cPath As String = "C:\users\mark\downloads\Q_28631627"
    
    Set oFS = CreateObject("scripting.filesystemobject")
    For Each oFile In oFS.getfolder(cPath).Files
        Set oTS = oFS.OpenTextFile(oFile.Path, ForReading, True, TristateFalse)
        strFileData = oTS.readall
        oTS.Close
        ParseAndPlaceData strFileData
    Next
    
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
dsmcl71Author Commented:
aikimark,

Looks to be working great, attached file has a couple of days imported data. Going to run it on a months worth to see what it does.

Just a few questions though:

1) I have to remove the "used" text files before running macro again or it imports the whole lot again - is this assumption correct? I have not tested that part yet.

2) Is there a way to get the code to separate the "Supplier" info into "Date" and "Zone" (i.e. two separate cells)? Same with the Dozens data; i.e. separate the dozens count into two cells with "dozens" count (left number) in one cell and the "singles" (right hand number) count in next column? This would eliminate the need for a second table using formulas to separate the information.

3) Is there a way to change the number formats? I think the format used in the text file is based on European number formatting and I'm concerned that the use of the decimal (.) for the thousands separator may cause an issue in further calculations.

Thank you.
NewImportFile.xlsm
0
dsmcl71Author Commented:
Hi aikimark,

Just ran the code with this years (3 months) data and got this debug error. It looks like all the data was imported into the file and at first glance still looks correct. Not sure what the error means though?
DebugError.JPG
0
aikimarkCommented:
1. you are correct.  The files in the source directory are not altered/moved/deleted
2. yes. There are ways to do this
3. It means that it wasn't able to open one of the text files in the source directory.  Most likely, it was open or had been deleted/renamed during the run.

Since this seems to solve the problem you posted, it would be better to close this question and then open a new one with your additional requirements.  Be sure to include a link to this question in your new question.  Post a comment in this thread with a link to your new question.
0
Zack BarresseCEOCommented:
To test whether the file is open or not, append a simple If/Then test to the Q_.... routine, include the function below...

Sub Q_28631627()

    Dim oFS, oTS, oFile
    Dim strFileData As String
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Const cPath As String = "C:\users\mark\downloads\Q_28631627"
    
    Set oFS = CreateObject("scripting.filesystemobject")
    For Each oFile In oFS.getfolder(cPath).Files
        If ISFILEOPEN(oFile.Name) = False And LCase(oFile.Name) Like "*.txt" Then
            Set oTS = oFS.OpenTextFile(oFile.Path, ForReading, True, TristateFalse)
            strFileData = oTS.readall
            oTS.Close
            ParseAndPlaceData strFileData
        End If
    Next
    
End Sub


Function ISFILEOPEN(FileName As String) As Boolean
    Dim iFilenum As Long
    On Error Resume Next
    iFilenum = FreeFile()
    Open FileName For Binary Access Read Write Lock Read Write As #iFilenum
    Close iFilenum
    On Error GoTo 0
    ISFILEOPEN = CBool(Err.Number <> 0)
End Function

Open in new window


There are other tests you could do, like checking if the 'oTS' variable is nothing (would need error handling to encapsulate the Set line), etc.

To move the files after processing is very easy as well. The amended Q_... routine has an additional constant and a couple lines of code to do this. Adjust your destination directory as desired...

Sub Q_28631627()

    Dim oFS, oTS, oFile
    Dim strFileData As String
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Const cPath As String = "C:\users\mark\downloads\Q_28631627"
    Const cMovePath As String = "C:\users\mark\downloads\Q_28631627\completed"
    
    Set oFS = CreateObject("scripting.filesystemobject")
    If oFS.FolderExists(cMovePath) = False Then oFS.CreateFolder (cMovePath)
    
    For Each oFile In oFS.getfolder(cPath).Files
        If ISFILEOPEN(oFile.Name) = False And LCase(oFile.Name) Like "*.txt" Then
            Set oTS = oFS.OpenTextFile(oFile.Path, ForReading, True, TristateFalse)
            strFileData = oTS.readall
            oTS.Close
            ParseAndPlaceData strFileData
            oFile.Move cMovePath & "\" & oFile.Name
        End If
    Next
    
End Sub

Open in new window


Regards,
Zack
0
dsmcl71Author Commented:
Hi Zack,

Thanks for your input. Where do I physically paste your code into the original macro (after, or somewhere else), and/or do I need to modify anything in the original routine to accommodate your suggested changes?
0
Zack BarresseCEOCommented:
No, you don't need to change the original routine. Aikimark only posted two routines. One of those I edited but left the name the same. You should have those two routines plus the ISFILEOPEN function, for a total of three procedures. You can replace the entire 'Q_28631627' routine with the last one I posted. If you read the code it's almost identical, but has the additional checks I mentioned, making it more robust and closer to what you asked for.

All code goes in a standard module.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

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.