Textdatei als Endlosschleife einlesen (5)

.Range("XY").Copy
.Range("AB").PasteSpecial xlPasteValues

Array = .Range("XY")
.Range("AB") = Array

Option Explicit
Public Datei(0 To 2) As String
Public SpeicherZeit(0 To 2) As Date
Public B7
Public XmaxScale
Public BolStop As Boolean
Public datStartTime As Date
Sub Makro1()
Start
Einlesen
End Sub

Sub Start()
'starten BEVOR das Messen beginnt
Dim WB As Workbook
Dim Import As Worksheet
Dim Sp()
Dim LC, LR, Statuscalc As Long
Dim i, TMP, TB, Spa As Integer
Dim Arr, SpecArr, j
Dim qt, BackgroundQuery
Set Import = ThisWorkbook.Sheets("IMPORT")
Sp = Array(2, 5, 8)
Import.Activate
KILLQUERY
Import.Range("A5:Z10000").Clear
Datei(0) = Import.Range("B2")
Datei(1) = Import.Range("B3")
Datei(2) = Import.Range("B4")
For i = 0 To 2
SpeicherZeit(i) = FileDateTime(Datei(i))
Import.Cells(7, Sp(i)) = FileDateTime(Datei(i))
j = "TEXT;" & Datei(i)
With Import.QueryTables.Add(Connection:=j, Destination:=Import.Cells(8, Sp(i)))
.AdjustColumnWidth = False
.FieldNames = True
.FillAdjacentFormulas = False
.Name = "MeasurementPosition" & (i)
.PreserveFormatting = True
.Refresh BackgroundQuery:=False
.RefreshOnFileOpen = False
.RefreshPeriod = 0
.RefreshStyle = xlOverwriteCells
.RowNumbers = False
.SaveData = False
.SavePassword = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileCommaDelimiter = True
.TextFileConsecutiveDelimiter = False
.TextFileParseType = xlDelimited
.TextFilePlatform = 437
.TextFilePromptOnRefresh = False
.TextFileSemicolonDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileStartRow = 1
.TextFileTabDelimiter = True
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileTrailingMinusNumbers = True
End With
Next i
For Each qt In Import.QueryTables
On Error Resume Next
qt.Refresh (BackgroundQuery)
Next
BolStop = False
ThisWorkbook.Sheets("MAIN").Activate
End Sub
Sub Einlesen()
Dim WB As Workbook
Dim Import As Worksheet
Dim Sp()
Dim LC, LR, Statuscalc As Long
Dim i, TMP, TB, Spa As Integer
Dim Arr, SpecArr, j
Dim qt, BackgroundQuery
Set Import = ThisWorkbook.Sheets("Import")
Debug.Print "neu -Einlesen-" & Format(Now, "YYYY-MM-DD hh:mm:ss")
Sp = Array(2, 5, 8)
While BolStop = False
For Each qt In Import.QueryTables
qt.Refresh (BackgroundQuery)
Next
With Application
.ScreenUpdating = False
.EnableEvents = False
Statuscalc = .Calculation
.Calculation = xlCalculationManual
.AutoRecover.Enabled = False
End With
If BolStop = True Then GoTo Beenden
B7 = Import.Range("B7")     'Write the old Import time into B7
For i = 0 To 2
Import.Cells(7, Sp(i)) = FileDateTime(Datei(i))
Next i
'after import is finished, recalucate all
ThisWorkbook.Sheets("MAIN").Range("H9") = B7
Application.Calculate
With Application
.ScreenUpdating = True
.EnableEvents = True
DoEvents
.ScreenUpdating = False
.EnableEvents = False
End With
If Import.Range("B7")  B7 Then 'Wert hat sich geändert
B7 = Import.Range("B7")
Set TB = ThisWorkbook.Sheets("EXPORT")
Spa = 1 'Spalte A
LR = TB.Cells(TB.Rows.Count, Spa).End(xlUp).Row + 1
LR = IIf(LR  XmaxScale Then 'Wert hat sich geändert
Diagramm_Update
XmaxScale = ThisWorkbook.Sheets("CHARTS").Cells(37, 2)
End If
Update_Warning
Update_RGB
Wend
Beenden:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = Statuscalc
.AutoRecover.Enabled = True
End With
End Sub
Sub Stopp_Click()
Dim TB As Worksheet
Set TB = ThisWorkbook.Sheets("MAIN")
TB.Shapes("WARNING1").Visible = False
TB.Shapes("WARNING2").Visible = False
BolStop = True
KILLQUERY
End Sub

Sub KILLQUERY()
Dim cn
For Each cn In ThisWorkbook.Connections
cn.Delete
Next cn
For Each cn In ActiveSheet.QueryTables
cn.Delete
Next cn
End Sub