Hilfe Kompatibilitätsproblem
11.08.2008 15:48:30
christian
ich habe leider immer noch das Kompatibilitätsproblem!
Zum Verständnis nochmal die Anforderungen an den Code:
Importieren aller in einem Ordner befindlichen Textdateien (Messwerte) in neue Tabellenblätter
Das funktioniert auch alles super, da hat Rudi ganze Arbeit geleistet!
Jetzt brauche ich das aber noch bei mir zu Hause! Und ich verzweifle bald!
Inzwischen ist die Situation so:
Auf Excel 2002 SP3 läuft alles super (auf Arbeit),
auf 2000 läufts überhaupt nicht (den Filedialog gibt es es erst ab Excel 2002! das hat man mir schon erklärt!)
auf 2003 und XP importiert er die Werte, schreibt aber kein einziges Komma. Somit habe ich dann zB keine 32 Newton sondern 320000 Newton.
Das ist nicht gut!
Vielleicht hat da jemand eine Idee, ich bin für jeden Tipp überaus dankbar!
Hier noch der Code:
Sub importTextFile()
'erweitert: Rudi Maintaire; 20080610
Dim lngIndex As Long, lngCnt As Long, intC As Integer
Dim strFile As String, strTmp As String, varValues() As Variant, varTmp As Variant
Dim strFolder As String, wks As Worksheet
Dim strSheetName As String
With Application.FileDialog(4)
.AllowMultiSelect = False
.InitialFileName = "G:\_EG-82(Werkstoffe)\A_METALL\Diplomarbeiten\DA-Heuer\Messergebnisse\" _
_
_
'Startpfad anpassen
.InitialView = 2
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
strFolder = strFolder & "\"
strFile = Dir(strFolder & "*.txt")
Do While strFile ""
strSheetName = Replace(strFile, ".txt", "")
lngIndex = 0
Open strFolder & strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
Loop
Close #1
ReDim varValues(1 To lngCnt - 32, 1 To 10)
lngCnt = 0
Open strFolder & strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
If lngCnt > 32 Then
If Len(strTmp) > 0 Then
strTmp = Trim$(strTmp)
If Right(strTmp, 1) = Chr(9) Then strTmp = Left(strTmp, Len(strTmp) - 1)
lngIndex = lngIndex + 1
varTmp = Split(strTmp, vbTab)
For intC = 0 To UBound(varTmp)
varValues(lngIndex, intC + 1) = Replace(varTmp(intC), ".", ",")
Next
End If
End If
Loop
Close #1
If lngIndex > 0 Then
'Worksheet vorhanden?
On Error Resume Next
Set wks = Worksheets(strSheetName)
On Error GoTo 0
'Wenn nicht, dann einfügen
If wks Is Nothing Then
Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count))
wks.Name = strSheetName
End If
With wks
.Cells.ClearContents
.Range(.Cells(1, 1), .Cells(UBound(varValues, 1), UBound(varValues, 2))) = varValues
End With
End If
Set wks = Nothing
strFile = Dir
Loop
Sheets("Tabelle1").Select
End Sub
Für Eure Mühen bedanke ich mich schon mal!
Christian