nachdem Rudi Maintaire mir letzte Woche sehr gut geholfen hat (Problemstellung = "Dateinamen bearbeiten"), bitte ich hier nochmal um weitere Unterstützung.
Jetzt stellt sich folgendes Problem:
Die Datei wird richtig ausgelesen, und korrekt eingefügt.
Nur mit der Zellenformatierung bekomme ich das nicht auf die Reihe.
Alle Zellen müßten mit "Standard" Format eingefügt werden, nur Zelle "A4" im Benutzerdefiniertem Format "TT.MM.JJJJ hh:mm".
Bei meinem ersten Makro (funktionierte nicht wegen sich ständig ändernden Dateinamen), klappte das.
Gruß
Rainer
NEU
Option Explicit
Dim sPfad As String, DateiName As String, sFile As String
Sub auto_open()
sPfad = "D:\labor\Anton_Paar\Export\"
DateiName = "Analyse_*.lims"
Application.OnTime Now + TimeValue("00:00:00"), "Alle_5_Sekunden"
End Sub
Sub Alle_5_Sekunden()
sFile = Dir(sPfad & DateiName)
If sFile "" Then
Application.OnTime Now + TimeValue("00:00:10"), "AusTextDatei"
Else
Application.OnTime Now + TimeValue("00:00:05"), "Alle_5_Sekunden"
End If
End Sub
Sub AusTextDatei()
Dim intRow As Integer, intcol As Integer
Dim strTxt As String, arrTmp
Sheets("ausgelesene_Daten").Select
Range("A1:da5").Select
Selection.ClearContents
Range("A1").CurrentRegion.ClearContents
Open sPfad & sFile For Input As #1
Do Until EOF(1)
intRow = intRow + 1
intcol = 0
Line Input #1, strTxt
arrTmp = Split(strTxt, ";")
Cells(intRow, 1).Resize(, UBound(arrTmp) + 1) = arrTmp
Loop
Close #1
Kill sPfad & sFile
Sheets("ausgelesene_Daten").Select
Call ausdruck
Call auto_open
End Sub
Altes MakroOption Explicit
Dim Pfad As String
Dim Dateiname As String
Sub auto_open()
Pfad = "d:\labor\Anton_Paar\Export"
Dateiname = "test_1.lims"
Application.OnTime Now + TimeValue("00:00:00"), "Alle_5_Sekunden"
End Sub
Sub Alle_5_Sekunden()
If Dir(Pfad & Dateiname) "" Then
Application.OnTime Now + TimeValue("00:00:09"), "AusTextDatei"
Else
Application.OnTime Now + TimeValue("00:00:05"), "Alle_5_Sekunden"
End If
End Sub
Sub AusTextDatei()
Sheets("ausgelesene_Daten").Select
Dim intRow As Integer, intCol As Integer
Dim strTxt As String
Dim strFile As String
strFile = "d:\labor\Anton_Paar\Export\test_1.lims"
Range("A1:da5").Select
Selection.ClearContents
Range("A1").CurrentRegion.ClearContents
If Dir(strFile) = "" Then
MsgBox "Kann Mess - Datei nicht finden -"
Else
Open "D:\labor\Anton_Paar\Export\test_1.lims" For Input As #1
End If
Do Until EOF(1)
intRow = intRow + 1
intCol = 0
Line Input #1, strTxt
Do Until InStr(strTxt, ";") = 0
intCol = intCol + 1
Cells(intRow, intCol) = Left(strTxt, InStr(strTxt, ";") - 1)
strTxt = Right(strTxt, Len(strTxt) - InStr(strTxt, ";"))
Loop
Cells(intRow, intCol + 1) = strTxt
Loop
Close
Sheets("ausgelesene_Daten").Select
Range("A1").Select
Kill "D:\Labor\Anton_Paar\Export\Test_1.lims"
Call auswahl
Call auto_open
End Sub