Extract Data between Lines from txt to VBA spreadsheet

Asked

Viewed 1,371 times

2

I am creating a code that will automate reports at work from a button. The measuring equipment gives me a file in . mmf or . txt, and there’s an important part that I’m cracking my head to solve and I’m a few days away from moving forward.

Below is the text I want to extract, the data (numbers separated by a semicolon) always has the same amount of columns and the rows vary according to the measurement made. I want to figure out how to remove everything between "Mwttandeltavalues=" and "Mwttandeltatimevalues=" and paste it into the spreadsheet. Follow a part of the file containing the excerpt I need to extract (in bold):

MWTTanDeltaMean=27.0355 MWTTanDeltaSTD=2.3498

MWTTanDeltaChangeOverTime=1.8083

Mwttandeltaduration= 15

MWTTanDeltaMeanPeakVoltage=34475.3700

Mwttanfrequency=0.1000

Mwttandeltavalues=

27.5766;27.5707;27.3737;26.6112;26.0126;26.2416;26.1120; 26.1621;25.7420;25.9710;25.6238;25.7683;25.8689;26.1269; 26.1321;26.2643;25.7848;25.1501;25.3091;25.0000;25.3175; 25.5920;24.8733;24.6167;24.6299;24.7430;25.4183;25.9896; 25.4958;25.4259;26.4650;25.7657;30.0259;30.5261;30.2207; 30.7683;30.5524;31.4316;30.5092;31.2188;31.3513;31.4804; 31.1870;31.5287;31.2671;30.7482;29.5514;28.6546;29.6851; 29.2009;29.2151;29.1309;29.1466;33.0232;31.8877;30.4890; 26.8053;27.0559;26.8480;25.6997;25.8613;26.7863;26.0611; 26.7878;27.2462;25.6071;25.9075;25.9302;25.8017;26.8502; 26.7850;26.3517;25.5865;26.1033;25.8408;26.2310;25.0309; 23.9557;24.0468;24.0217;23.7751;24.5628;24.3670;24.3429; 25.5378;27.6765;24.4876;24.7278;23.9403;

Mwttandeltatimevalues=

25.8168;27.8008;27.0355;

Mwttandeltastdtimevalues=

0.7685;2.4520;2.3498;

Mwttandeltachangetimevalues=

[Result]

Smileyphase1=3

Temperature=

Measurementresult=0 TEST SEQUENCE COMPLETED SUCCESSFULLY

2017-12-27 14.08

That solution would solve any other problem I might have in the future.

Thank you in advance!

vba txt import

1 answer

1

Regex

Enable Regex in Excel VBA

  1. Regex needs to be enabled, Enable the Developer mode
  2. In the 'Developer' tab, click 'Visual Basic' and the VBA window will open.
  3. Go to 'Tools' -> 'References...' and a window will open.
  4. Search for 'Microsoft Vbscript Regular Expressions 5.5', as in the image below. And enable this option.

Janela Referências

Standard

A simple Regex that identifies a group that is between MWTTanDeltaValues= and MWTTanDeltaTimeValues=:

MWTTanDeltaValues=\s*([\s\S]+)(?=MWTTanDeltaTimeValues=)

Demo in Regex101

VBA code

Find txt file and remove string

Finds the defined file or if it does not find the user chooses the file. Open . txt and find the desired String.

Sub EncontrarTXT()

Dim objStream As Object
Dim strData As String
Dim fileName As String, textData As String, fileNo As Integer
sFilename = "teste.txt"
'    sFilename = Sheets("Planilha1").Range("A1")
sFilepath = ThisWorkbook.Path & "\" & sFilename
fileNo = FreeFile                            'Get first free file number


Inicio:
If Dir(sFilepath) <> "" Then
    Open sFilepath For Input As #fileNo
    strData = Input$(LOF(fileNo), fileNo)

    Dim objMatches As Object, objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    'Regex https://regex101.com/r/gXOEV9/1
    objRegExp.Pattern = "MWTTanDeltaValues=\s*([\s\S]+)(?=MWTTanDeltaTimeValues=)"
    objRegExp.Global = True

    Set objMatches = objRegExp.Execute(strData)
    If objMatches.Count <> 0 Then

        For Each m In objMatches
            'Imprime na janela de Verificação Imediata
'                Debug.Print m.Submatches(0)
            'Preenche a célula A1 da planilha Planilha1
'                Sheets("Planilha1").Range("A1") = m.Submatches(0)
        Next m
    End If
Else
    MsgBox "O arquivo txt não pôde ser carregado - Escolha o caminho."
    sFilepath = EscolherArquivo
    If Dir(sFilepath) <> "" Then GoTo Inicio
End If
'Close
Close #fileNo

End Sub

Choose Archive

If you do not find the path referred in the code, a window will open to choose the file on the system.

Public Function EscolherArquivo() As String
'Créditos: http://software-solutions-online.com/excel-vba-open-file-dialog/
Dim intChoice As Long
Dim strPath As String

'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
    'get the file path selected by the user
    strPath = Application.FileDialog( _
              msoFileDialogOpen).SelectedItems(1)
    'print the file path to sheet 1
    EscolherArquivo = strPath
End If
End Function

Upshot

Is this String:

27.5766;27.5707;27.3737;26.6112;26.0126;26.2416;26.1120; 26.1621;25.7420;25.9710;25.6238;25.7683;25.8689;26.1269; 26.1321;26.2643;25.7848;25.1501;25.3091;25.0000;25.3175; 25.5920;24.8733;24.6167;24.6299;24.7430;25.4183;25.9896; 25.4958;25.4259;26.4650;25.7657;30.0259;30.5261;30.2207; 30.7683;30.5524;31.4316;30.5092;31.2188;31.3513;31.4804; 31.1870;31.5287;31.2671;30.7482;29.5514;28.6546;29.6851; 29.2009;29.2151;29.1309;29.1466;33.0232;31.8877;30.4890; 26.8053;27.0559;26.8480;25.6997;25.8613;26.7863;26.0611; 26.7878;27.2462;25.6071;25.9075;25.9302;25.8017;26.8502; 26.7850;26.3517;25.5865;26.1033;25.8408;26.2310;25.0309; 23.9557;24.0468;24.0217;23.7751;24.5628;24.3670;24.3429; 25.5378;27.6765;24.4876;24.7278;23.9403;

Explanation

  • sFilename = "teste.txt"

String that defines the file name

  • sFilepath = ThisWorkbook.Path & "\" & sFilename

String that defines the file path, where is the concatenation of the current Excel file path & the file name.

  • Inicio:

Marks the beginning of the code

  • If Dir(sFilepath) <> "" Then

If the directory defined in sFilepath if found, follow the code to open the txt and extract the string.

  • Else

Otherwise...

  • sFilepath = EscolherArquivo

The user chooses the file to be used by calling the function EscolherArquivo

  • GoTo Inicio

After choosing the file, return to the Inicio:

  • Open sFilepath For Input As #fileNo

Open the txt file

  • strData = Input$(LOF(fileNo), fileNo)

Defines the String strData with the txt file data.

  • Dim objMatches As Object, objRegExp As Object: Set objRegExp = CreateObject("VBScript.RegExp"):'Regex https://regex101.com/r/gXOEV9/1 : objRegExp.Pattern = "MWTTanDeltaValues=\s*([\s\S]+)(?=MWTTanDeltaTimeValues=)" : objRegExp.Global = True

Sets the Regex parameters.

  • Set objMatches = objRegExp.Execute(strData)

Runs Regex on String strData

  • If objMatches.Count <> 0 Then

If any regex results are found, then...

  • For Each m In objMatches: Next m

For each match found in Regex

  • Debug.Print m.Submatches(0)

Print Match Group 1 in Immediate Verification

  • Sheets("Planilha1").Range("A1") = m.Submatches(0)

Fills cell A1 of the Spreadsheet worksheet

Browser other questions tagged vba txt import

You are not signed in. Login or sign up in order to post.