Untitled
Guest 149 14th May, 2024
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