Public
Sub
Csv_import()
Debug.Print
"importing .csv data... "
Dim
Anf
As
Long
Dim
Appshell
As
Variant
Dim
ap
As
String
Dim
BrowseDir
As
Variant
Dim
f
As
Variant
Dim
csvPFAD
As
String
Dim
wbTarget
As
Workbook, wbSource
As
Workbook, ws
As
Worksheet
Dim
FSO
As
Object
Set
FSO = CreateObject(
"Scripting.Filesystemobject"
)
Set
wbTarget = ActiveWorkbook
Dim
strTest
As
String
Dim
Arr(3)
As
String
Dim
Zähler
As
Long
Dim
Zeile
As
String
Dim
t()
As
String
Dim
i
As
Long
, k
As
Long
Dim
c
As
Long
ap =
""
""
Anf = 0
Zähler = 0
Set
Appshell = CreateObject(
"Shell.Application"
)
Set
BrowseDir = Appshell.BrowseForFolder(0,
"Ordner auswählen"
, &H1000,
"BITTE ORDNER PFAD HIER EINFÜGEN"
)
On
Error
GoTo
Abbrechen
csvPFAD = BrowseDir.items().Item().path
Application.DisplayAlerts =
False
Application.ScreenUpdating =
False
Set
wbSource = ActiveWorkbook
For
Each
f
In
FSO.GetFolder(csvPFAD).Files
If
LCase(Right(f.name, 3)) =
"csv"
Then
Set
ws = wbTarget.Worksheets.Add
ws.Move Before:=Worksheets(
"DEIN AUSWERTUNGSSHEET"
)
On
Error
GoTo
Fehler
Open csvPFAD & "\" & f.name
For
Input
As
1
i = 1
Do
Until
EOF(1)
Line Input #1, Zeile
t = Split(Zeile,
";"
)
For
k = 0
To
UBound(t)
t(k) = Replace(t(k),
","
,
"."
)
Cells(i, Anf + k + 1).Value = t(k)
Next
k
i = i + 1
Loop
Close 1
End
If
Application.ActiveSheet.name =
"IMPORT"
& Zähler + 1
Zähler = Zähler + 1
Next
Application.DisplayAlerts =
False
c = 1
Do
While
wsexist(
"IMPORT"
& c)
Worksheets(
"IMPORT"
& c).Delete
c = c + 1
Loop
Set
FSO =
Nothing
Exit
Sub
Abbrechen:
End
Fehler:
MsgBox (Err.Description)
End
Sub