Kompatibilitätsproblem
23.07.2008 18:37:56
Christian
Rudi schrieb mir vor einiger Zeit einen Code mit dem ich mehrere Textdatein in eine Exceldatei importieren kann!
Dies funktioniert mit dem 2003er einwandfrei, hier nochmal Dank an Rudi.
Jetzt brauche ich diesen Code auch auf einem Rechner mit Office 2000 und da kommt folgende Fehlermeldung:
Laufzeitfehler 438
Objekt unterstützt diese Eigenschaft oder Methode nicht
Hier noch der Code dazu:
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
Vielen Dank im voraus
Christian