Thema Datum  Von Nutzer Rating
Antwort
25.12.2015 17:29:48 kaba
NotSolved
25.12.2015 21:54:30 Gast84843
NotSolved
26.12.2015 00:21:18 Gast24916
NotSolved
26.12.2015 11:04:08 Gast31427
NotSolved
Rot 3 Probleme mit meinem Text-Import script
26.12.2015 19:47:04 Gast44228
NotSolved
26.12.2015 21:25:23 Gast33581
NotSolved
27.12.2015 17:07:30 Gast15252
NotSolved
27.12.2015 18:33:40 Gast11408
NotSolved
27.12.2015 21:46:20 Gast79845
NotSolved
27.12.2015 23:11:01 Gast51998
NotSolved
28.12.2015 00:18:41 Gast63692
NotSolved
28.12.2015 00:23:42 Gast45800
NotSolved
28.12.2015 12:13:26 Gast20098
NotSolved
28.12.2015 13:17:10 Gast28188
NotSolved
28.12.2015 16:27:18 Gast74702
NotSolved
28.12.2015 16:39:19 Gast79553
NotSolved
28.12.2015 20:34:51 Gast47519
NotSolved
29.12.2015 01:30:11 Gast34909
NotSolved
29.12.2015 08:37:15 Gast24437
NotSolved
29.12.2015 09:51:40 Gast52305
NotSolved
29.12.2015 13:43:19 Gast74900
NotSolved
29.12.2015 17:10:59 kaba
NotSolved
29.12.2015 22:05:52 Gast93041
NotSolved
29.12.2015 23:00:04 Gast65849
NotSolved
30.12.2015 10:21:02 Gast36151
*****
Solved
30.12.2015 20:23:27 kaba
NotSolved
30.12.2015 22:54:25 Gast78976
NotSolved
31.12.2015 11:51:11 Gast23361
NotSolved
31.12.2015 12:55:44 Gast2945
NotSolved
31.12.2015 13:09:25 Gast71405
*****
Solved
03.01.2016 12:42:43 kaba
Solved
31.12.2015 11:40:43 Gast8396
NotSolved
31.12.2015 12:57:09 Gast64794
NotSolved

Ansicht des Beitrags:
Von:
Gast44228
Datum:
26.12.2015 19:47:04
Views:
932
Rating: Antwort:
  Ja
Thema:
3 Probleme mit meinem Text-Import script

Also hier jetzt mal eine Version die funktionieren sollte. Sie liest (theoretisch :-) ) alle Ordner / Unterordner aus und liest dann alle txt Dateinen ein. Die werden in einem Array übergeben und dann ausgelesen. Gruß

 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Dim dateien()
Option Explicit
 
Sub DateienLesen()
    Call EventsOff
    Dim DateiName As String
    Dim quelle As String
    Dim i As Long
    
    ReDim dateien(0)
    dateien(0) = 0
     
    quelle = "C:\Tmp\test_txt"
    Call txtsuchen(quelle)
     
  
    If dateien(0) = 0 Then
    MsgBox "Keine .txt Dateien gefunden!"
    Else
    'Daten auslesen
     
        For i = 1 To dateien(0)
        DateiName = dateien(i)
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Tmp\test_txt\" & DateiName, Destination:=Range("C" & ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 2))
            .Name = DateiName
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 1252
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1)
            .Refresh BackgroundQuery:=False
        End With
         
        Next i
    End If
  
     
    Call EventsOn
End Sub
  
Public Sub EventsOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub
  
Public Sub EventsOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
Function txtsuchen(quelle As String)
Dim suche
Dim ordner()
Dim i As Long
 
ReDim ordner(0)
ordner(0) = 0
ChDir (quelle)
'Ordner durchschauen
suche = Dir(quelle & "\*.*", vbDirectory)
 
Do Until suche = ""
    'Normale Dateien rausfiltern
    If (GetAttr(quelle & "\" & suche) = 16) Then
        'die hier ankommen, sind Ordner, extra speichern
        ordner(0) = ordner(0) + 1
        ReDim Preserve ordner(ordner(0))
        ordner(ordner(0)) = suche
    Else
        If Right(suche, 4) = ".txt" Then
            dateien(0) = dateien(0) + 1
            ReDim Preserve dateien(dateien(0))
            dateien(dateien(0)) = suche
        End If
    End If
         
    suche = Dir()
Loop
'jetzt durch die Ordner gehen
For i = 1 To UBound(ordner)
    If Dir(ordner(i), vbNormal) = "" And Left(ordner(i), 1) <> "." Then
        Call txtsuchen(quelle & "\" & ordner(i))
        ChDir (quelle)
    End If
Next
End Function

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
25.12.2015 17:29:48 kaba
NotSolved
25.12.2015 21:54:30 Gast84843
NotSolved
26.12.2015 00:21:18 Gast24916
NotSolved
26.12.2015 11:04:08 Gast31427
NotSolved
Rot 3 Probleme mit meinem Text-Import script
26.12.2015 19:47:04 Gast44228
NotSolved
26.12.2015 21:25:23 Gast33581
NotSolved
27.12.2015 17:07:30 Gast15252
NotSolved
27.12.2015 18:33:40 Gast11408
NotSolved
27.12.2015 21:46:20 Gast79845
NotSolved
27.12.2015 23:11:01 Gast51998
NotSolved
28.12.2015 00:18:41 Gast63692
NotSolved
28.12.2015 00:23:42 Gast45800
NotSolved
28.12.2015 12:13:26 Gast20098
NotSolved
28.12.2015 13:17:10 Gast28188
NotSolved
28.12.2015 16:27:18 Gast74702
NotSolved
28.12.2015 16:39:19 Gast79553
NotSolved
28.12.2015 20:34:51 Gast47519
NotSolved
29.12.2015 01:30:11 Gast34909
NotSolved
29.12.2015 08:37:15 Gast24437
NotSolved
29.12.2015 09:51:40 Gast52305
NotSolved
29.12.2015 13:43:19 Gast74900
NotSolved
29.12.2015 17:10:59 kaba
NotSolved
29.12.2015 22:05:52 Gast93041
NotSolved
29.12.2015 23:00:04 Gast65849
NotSolved
30.12.2015 10:21:02 Gast36151
*****
Solved
30.12.2015 20:23:27 kaba
NotSolved
30.12.2015 22:54:25 Gast78976
NotSolved
31.12.2015 11:51:11 Gast23361
NotSolved
31.12.2015 12:55:44 Gast2945
NotSolved
31.12.2015 13:09:25 Gast71405
*****
Solved
03.01.2016 12:42:43 kaba
Solved
31.12.2015 11:40:43 Gast8396
NotSolved
31.12.2015 12:57:09 Gast64794
NotSolved