Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

txt Dateien in Excel arbeitsblätter (2)

Betrifft: txt Dateien in Excel arbeitsblätter (2)
von: Dan
Geschrieben am: 16.04.2003 - 11:29:16

Ich habe ein Problem, beim Öffnen von mehreren txt-Dateien werden auch mehrere Arbeitsmappen (xls-Dateien) erstellt. Ich möchte, daß die txt-Dateien in einer Arbeitsmappe in mehreren Arbeitsblättern geöffnet werden. Frage: ist dies möglich? Wenn ja, dann wäre eine VBA-programmieranleitung von Nöten.
Folgende Zeilen zeigen den Programmcode. Beim öffnen der txt-Dateien sollte auch die Importierung der der einzelenen Spalten funktionieren.
(siehe letzte Zeilen)

für Tipps wäre ich sehr dankbar. inwiefern kann man mein programm mit dem folgenden code verknüpfen? so dass es funktioniert.

hier der code:


Dim DatName As Variant
DatName = Workbooks.Application.GetOpenFilename
If TypeName(DatName) = "Boolean" Then Exit Sub
Sheets.Add Type:=DatName


mein Prigramm:

Dim Check, Counter
Dim i, dIndex As Integer

'
' Öffnen der Datei***********************************************************
Dim sDatei As String
sDatei = "C:\btr\Projekte\bcc\Auswertung\14490236-BTR-2-2.txt"
dIndex = 1

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt", 1, , , True)

sDatei = TypeName(fileToOpen)
If sDatei = "Boolean" Then
If sDatei = False Then
Exit Sub
End If
End If
If TypeName(fileToOpen) <> "Variant()" Then
Exit Sub
End If

Do While dIndex <= UBound(fileToOpen)
sDatei = fileToOpen(dIndex)
Workbooks.OpenText Filename:= _
sDatei, 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, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))

mfg dan


  

Re: txt Dateien in Excel arbeitsblätter (2)
von: Nike
Geschrieben am: 16.04.2003 - 11:45:56

Hi,

dafür mußt du die Inhalte der Txt Dateien in die eine Mappe rüberkopieren.
Excel erstellt aus jeder .txt Datei eine eigene Mappe mit
jeweils einer Tabelle.

Versuchs mal mit diesem Schnipsel...
Ich hab`s nicht ausprobiert, da ich nicht deine .txt files hab.
Es sind ein paar Passagen auskommentiert,
dadurch nicht irritieren lassen ;-)

Bye

Nike


Option Explicit
Dim arrFilenames As Variant

Sub Txt_Import()
'Wiederverwendbarer Oeffnen Dialog
Dim wkb As Workbook
Dim wksZiel As Worksheet
Dim wkbQuell As Workbook
Dim wksQuell As Worksheet
Dim lngQSpalt As Long
Dim lngQZeil As Long
Dim lngZZeil As Long
Dim varArr As Variant

Dim i As Integer
Dim strNam As String
wkb = ActiveWorkbook
wksZiel = wkb.Worksheets(1)
lngZZeil = wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row + 1

Selection:
   ' Zu öffnende Dateien erfragen
    arrFilenames = Application.GetOpenFilename( _
        "Txt Dateien (*.txt), *.txt", 1, _
        "Txt Dateien auswählen...", MultiSelect:=True)                ' Ausgewählte Datei des Öffnen-Dialoges in Feld ablegen
    If VarType(arrFilenames) = vbBoolean Then
        If MsgBox("Sie haben keine Dateien ausgewählt. Möchten sie das Makro beenden?", vbYesNo, "Frage") = vbNo Then
            GoTo Selection
        Else
            Exit Sub
        End If
    End If
    
    Application.ScreenUpdating = False
   ' Die vom Makro vorgenommenen Tätigkeiten
   ' bleiben zur Geschwidigkeitssteigerung unsichtbar
    
For i = 1 To UBound(arrFilenames)

'-------------------------------------------------------
'hier kommt dann der Code rein, der das ausgewählte Blatt
'betrifft. Die Ursprungsdatei ist über WB1 ansprechbar.
'für varArr einfach mal beim Öffnen den Makrorecorder beim Öffnen mitlaufen lassen.
varArr = Array(Array(1, 1), Array(2, 4), Array( _
3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))

Workbooks.OpenText FileName:=arrFilenames(i) _
    , Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
Space:=False, Other:=False, FieldInfo:=varArr
    
wkbQuell = ActiveWorkbook
wksQuell = ActiveSheet
wksQuell.Copy after:=wkb.Worksheets(wkb.Worksheets.Count)
'lngQZeil = wksQuell.Cells(wksQuell.Rows.Count, 1).End(xlUp).Row
'lngQSpalt = wksQuell.Cells(1, wksQuell.Columns.Count).End(xlToLeft).Column
'wksQuell.Range(wksQuell.Cells(1, 1), wksQuell.Cells(lngQZeil, lngQSpalt)).Copy _
'wksZiel.Range(wksZiel.Cells(lngZZeil, 1), wksZiel.Cells(lngZZeil + lngQZeil + 1, lngQSpalt))

wkbQuell.Close (False)

Next
'-------------------------------------------------------
    wkb.Save
    'Ursprüngliche Datei wieder aktivieren
    'wkb.Activate
    Application.ScreenUpdating = True
    'und den Monitor aktivieren
End Sub


Function FileOpenYet(FileName As String) As Boolean
'eine Funktion, die Prüft ob eine Datei schon geöffnet ist.
Dim s As String
On Error GoTo Nonexistent
s = Workbooks(FileName).name
FileOpenYet = True
Exit Function
Nonexistent:
FileOpenYet = False
End Function




 

Beiträge aus den Excel-Beispielen zum Thema "txt Dateien in Excel arbeitsblätter (2)"