AW: Importieren von Daten
21.07.2006 12:15:03
Daten
Hallo Andy,
das ist natürlich etwas völlig anderes. Der Typ der Datei spielt jetzt eine ganz entscheidende Rolle. Excel kann ja nicht aus jedem Datei-Typ Daten einlesen.
Ich habe hier mal für 3 Typen eine Lösung. Dabei ist es nicht einfach, alle Sonderfälle zu erfassen. Bei Textdateien macht es evtl. noch Sinn den "Origin" abzufragen. Das ganze kann man jetzt natürlich erweitern für andere Datei-Typen, wobei dann die jeweiligen Besonderheiten beim Öffnen/Import zu berücksichtigen sind.
Da Excel für verschiedene Dateiformate auch Importfilter/Konverter hat, reicht es möglichweise aus den Case "xls" um diese Dateiendungen zu erweitern. Konnte ich aber mangels Datenbasis nicht testen. Bei CSV-Dateien funktioniert dieser "einfache Weg" zumindest nicht. Evtl. muss man sich hier auch um den optionalen Paramter "Converter" und ggf. installierte Konversionsprogramme kümmern.
mfg
Franz
Sub Werte_aus_Datei_einfügen()
' ab der aktuell selektierten Position werden Daten aus anderer Datei eingefügt
Dim wb As Workbook, wks As Worksheet, wbAktiv As Workbook, wksAktiv As Worksheet
Dim rngZelle As Range
DateiName = Application.GetOpenFilename(Title:="Einzufügende Datei auswählen")
If DateiName = False Then Exit Sub
Set wbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
Set rngZelle = ActiveCell
Select Case Right(DateiName, 3)
Case "xls", "XLS"
' Daten aus den Tabellenblättern der Exceldatei einfügen
Set wb = Application.Workbooks.Open(Filename:=DateiName, ReadOnly:=True)
For Each wks In wb.Worksheets
If Not (wks.UsedRange.Cells.Count = 1 And IsEmpty(wks.UsedRange.Cells(1, 1))) Then
wks.UsedRange.Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
Set rngZelle = rngZelle.Offset(wks.UsedRange.Rows.Count, 0)
End If
Next wks
wb.Close savechanges:=False
Case "csv", "CSV"
' Daten aus einer CSV-Datei einfügen, Daten sind durch Semicolon getrennt
'CSV-Datei temporär als txt-Datei kopieren
VBA.FileCopy Source:=DateiName, Destination:=Left(DateiName, Len(DateiName) - 3) & "txt"
DateiName = Left(DateiName, Len(DateiName) - 3) & "txt"
Application.Workbooks.OpenText Filename:=DateiName, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False
Set wb = ActiveWorkbook
wb.Sheets(1).UsedRange.Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
wb.Close savechanges:=False
'Kopie wieder löschen
VBA.Kill (DateiName)
Case "txt", "TXT"
' Daten aus einer Text-Datei einfügen, Trennzeichen TAB oder Semicolon werden erkannt
Application.Workbooks.OpenText Filename:=DateiName, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False
Set wb = ActiveWorkbook
wb.Sheets(1).UsedRange.Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
wb.Close savechanges:=False
Case Else
MsgBox "Für den Dateityp von " & DateiName & " wird der Import nach Excel von diesem Makro nicht unterstützt!"
End Select
End Sub