Datenimport
13.02.2005 12:40:33
Uwe
ich versuche Daten aus einer Excel-Datei in eine Txt.-Datei auszulagern und anschließend wieder zu importieren. Unten aufgeführtes Makro funktioniert, wenn Blattname immer gleich ist. Bei mir ändert sich jedoch ständig der Blattname. Ich muss mich also auf den CodeNamen beziehen, da dieser immer gleich ist.
Wenn die Tabellenblattnamen ("Tabelle1, Tabelle2, etc") sich nicht ändert, dann laufen Export und Import sauber durch.
Wenn ich jedoch nach dem Export den Tabellenblattnamen z.B. in "Name1"; Name2; etc.") abändere, bekommer ich folgende Fehlermeldung:
Laufzeitfehler9 = Index außerhalb des gültigen Bereichs bei "Set wks = Sheets(arr(0))"
Dieser Fehler entsteht m.E. dadurch, dass beim Import nach dem Tabellenblattnamen gesucht wird und nicht nach dem Codenamen.
Ich weiss nur nicht, wie ich die Worksheets bzw. Sheets-Anweisung umschreiben soll und bitte um Unterstützung.
Gruß
Uwe
Option Explicit
Const strRange As String = "A1:L157" 'Datenbereich hier
Sub exportData()
Dim wks As Worksheet
Dim sFile As String, tmp As String
Dim arr As Variant
Dim n As Long, m As Integer
sFile = Application.GetSaveAsFilename(InitialFilename:=".txt", _
FileFilter:="Text Dateien (*.txt), *.txt")
If sFile = "Falsch" Then Exit Sub
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Close #1
Open sFile For Output As #1
For Each wks In ThisWorkbook.Worksheets
If LCase(wks.Range("A4")) = "kreditnehmer:" And wks.Visible = xlSheetVisible Then
'Identifizierung der Tabellen nach Eintrag in "A4" und Blatt = Sichtbar!
'Natürlich kann man auch eine beliebige andere Zelle verwenden, um den
'Export zu steuern!
Application.StatusBar = "Export Daten: " & wks.CodeName
arr = wks.Range(strRange).FormulaLocal
For m = 1 To UBound(arr, 2)
For n = 1 To UBound(arr, 1)
tmp = tmp & "|" & arr(n, m)
Next
Next
Print #1, wks.CodeName & tmp
wks.Range(strRange).ClearContents
End If
tmp = vbNullString
Next
Close #1
MsgBox "Die Daten wurden erfolgreich Exportiert!"
ERRORHANDLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With
End Sub
Sub importData2()
Dim wks As Worksheet
Dim sFile As String, tmp As String
Dim arr As Variant
Dim n As Long, m As Integer, i As Integer
Application.ScreenUpdating = False
sFile = Application.GetOpenFilename("Text Dateien (*.txt), *.txt")
If sFile = "Falsch" Then Exit Sub
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Open sFile For Input As #1
Do While Not EOF(1)
Input #1, tmp
arr = Split(tmp, ";")
For Each wks In Sheets
If wks.CodeName <> arr(0) Then
Set wks = Nothing
Else
Exit For
End If
Next
If wks Is Nothing Then
Close #1
MsgBox "Das Tabellenblatt zum Einfügen der Daten wurde gelöscht!"
Exit Sub
End If
For n = 1 To 157
For m = 1 To 12
i = i + 1
wks.Cells(n, m) = arr(i)
Next
Next
Loop
Close #1
ERRORHANDLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub