Einlesen unterschiedlicher dat Dateien
18.09.2004 11:22:21
TinoB
mit dem untenstehenden code wird eine *.dat datei eingelesen was auch funktioniert. nun hätte ich folgendes anliegen, besteht die möglichkeit zusätzlich auch eine *.stk datei einzulesen? soll also konkret heißen, der benutzer bekommt im dialogfeld der zu öffnenden datei beide vorhande dateitypen angezeigt, wenn er sich für die *.dat entscheidet soll der code an die stelle abc springen, entscheidet er sich für *.stk müsste der code halt an der stelle xyz weiter ausgeführt werden. das ganze kommt daher, weil die beiden dateitypen einen unterschiedlichen aufbau haben. ist dies überhaupt möglich? könnte mir da jemand helfen?
Danke
Tino
Sub Einlesen()
'öffnen, einlesen und konvertieren der Datei
Application.DisplayAlerts = False
ZuOeffnendeDatei = Application.GetOpenFilename("Text Files (*.dat), *.dat")
If ZuOeffnendeDatei = False Then Exit Sub
'Dateieigenschaften werden festgelegt
Workbooks.OpenText Filename:=ZuOeffnendeDatei, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True _
, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1) _
, Array(2, 4), Array(3, 2), Array(4, 1), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), _
Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15 _
, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), _
Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), Array(26, 9), Array(27, 9), Array( _
28, 9), Array(29, 9), Array(30, 2), Array(31, 2), Array(32, 2), Array(33, 2), Array(34, 9), _
Array(35, 9), Array(36, 9), Array(37, 9), Array(38, 9))
'Herkunftsdatei wird Variable zugewiesen
ZuOeffnendeDatei = ActiveWorkbook.Name
Workbooks(ZuOeffnendeDatei).Activate
Selection.CurrentRegion.Select
Range("A:AC").Select
Selection.Copy
Workbooks(ZuOeffnendeDatei).Close
AktuelleDatei = ActiveWorkbook.Name
Workbooks(AktuelleDatei).Activate
Tabelle3.Activate
'Sheets("Formeln").Select
Range("A20").Select
Selection.PasteSpecial
Range("A20").Select
End Sub