Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1284to1288
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Nachtrag zu Dateinamen bearbeiten

Nachtrag zu Dateinamen bearbeiten
21.11.2012 10:17:36
Rainer
Hallo zusammen,
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 Makro
Option 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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nachtrag zu Dateinamen bearbeiten
25.11.2012 22:49:38
fcs
Hallo Rainer,
passe dein Makro mal in die folgende Richtung an.
Ob es funktioniert hängt davon ab, was zur Zeit nach der Ausführung des Makros in Zelle A4 steht.
Gruß
Franz
Sub AusTextDatei()
Dim intRow As Integer, intcol As Integer
Dim strTxt As String, arrTmp
Dim sPfad, sFile
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
With Sheets("ausgelesene_Daten")
.Select
With .Range("A4")
strTxt = Trim(.Text)
.NumberFormat = "DD.MM.YYYY hh:mm"
If IsDate(strTxt) Then
.Value = CDate(strTxt)
ElseIf IsNumeric(strTxt) Then
.Value = CDbl(strTxt)
Else
.Value = strTxt
End If
End With
End With
´Call ausdruck
Call auto_open
End Sub

Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige