Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
996to1000
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

Kompatibilitätsproblem

Kompatibilitätsproblem
23.07.2008 18:37:56
Christian
Hallo liebe Excelgemeinde,
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kompatibilitätsproblem
23.07.2008 18:45:09
Bernd
Hi,
den Filedialog gibt es es erst ab Excel 2002.
mfg Bernd

AW: Kompatibilitätsproblem
24.07.2008 08:47:16
christian
Guten Morgen,
vielen Dank für die schnelle Antwort!
Jetzt ist das Problem zumindestens klar.
Meine VBA Kenntnisse sind miserabel, gibt es eine Möglichkeit den Code so umzuschreiben, dass er im 2000er funktioniert?
Danke Christian

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige