avatar
Untitled

Guest 87 14th May, 2024

MARKUP 2.45 KB
                                           
                         Sub LoadMultipleFiles()
    Dim fileDialog As FileDialog
    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fileDialog
        .AllowMultiSelect = True
        .Title = "Please select the ST1 files"
        .Filters.Add "Text Files", "*.txt"

        If .Show = -1 Then ' If OK is pressed
            Dim filePath As String
            For Each filePath In .SelectedItems
                ProcessFile filePath
            Next filePath
        Else
            MsgBox "No files were selected."
        End If
    End With
End Sub

Sub ProcessFile(filePath As String)
    Dim fileNum As Integer
    Dim textLine As String
    Dim conditionName As String
    Dim currentColumn As Integer
    Dim ws As Worksheet
    Dim lines() As String
    Dim dataStartRow As Integer
    Dim emptyLineCounter As Integer

    fileNum = FreeFile()
    Open filePath For Input As filePicNum
    Set ws = CreateUniqueWorksheet("ST1")
    currentColumn = 1
    emptyLineCounter = 0

    ' Read all text and handle different new line characters
    Dim allText As String
    allText = Input$(LOF(fileNum), fileNum)
    allText = Replace(allText, vbCrLf, vbLf)
    lines = Split(allText, vbLf)
    Close fileNum

    Dim i As Long
    For i = LBound(lines) To UBound(lines)
        textLine = Trim(lines(i))
        If textLine Like "*CONDITION NO.*" And i + 4 <= UBound(lines) Then
            conditionName = ExtractConditionName(lines(i + 4))
            SetHeaders ws, currentColumn, conditionName
            dataStartRow = i + 19
            If dataStartRow <= UBound(lines) Then
                emptyLineCounter = 0
                Dim dataRow As Integer
                dataRow = 4
                While dataStartRow <= UBound(lines) And emptyLineCounter < 2
                    If Trim(lines(dataStartRow)) = "" Then
                        emptyLineCounter = emptyLineCounter + 1
                    Else
                        emptyLineCounter = 0
                        FillData ws, lines(dataStartRow), currentColumn, dataRow, 19
                        dataRow = dataRow + 1
                    End If
                    dataStartRow = dataStartRow + 1
                Wend
                currentColumn = currentColumn + 20
            End If
        End If
    Next i
End Sub
                      
                                       
To share this paste please copy this url and send to your friends
RAW Paste Data
Recent Pastes
Ta strona używa plików cookie w celu usprawnienia i ułatwienia dostępu do serwisu oraz prowadzenia danych statystycznych. Dalsze korzystanie z tej witryny oznacza akceptację tego stanu rzeczy.
Wykorzystywanie plików Cookie
Jak wyłączyć cookies?
ROZUMIEM