Sub
ReadfromCSVSimple(fname
As
Variant
,
Optional
fs
As
String
=
";"
)
Dim
hfile
As
Integer
Dim
lAnzahl
As
Long
Dim
OneLine
As
String
Dim
myArr
As
Variant
Dim
myArrRows
As
Variant
Dim
lnglast
As
Long
Dim
zeichen
As
Variant
Dim
iCnt
As
Integer
ThisWorkbook.Worksheets(
"Projektübersicht"
).
Select
lnglast = Cells(Rows.Count, 1).
End
(xlUp).Row
If
IsEmpty(Cells(lnglast, 1))
Then
lnglast = Cells(lnglast, 1).
End
(xlUp).Row
lnglast = lnglast + 1
hfile = FreeFile
Open fname
For
Input
As
#hfile
Line Input #hfile, OneLine
Close #hfile
Kill fname
If
OneLine <>
""
Then
myArr = Split(OneLine,
";"
)
If
UBound(myArr) > 42
Then
With
Worksheets(
"Projektübersicht"
)
.Cells(lnglast, 33) = Replace(myArr(15), Chr$(34), vbNullString)
.Cells(lnglast, 37) = Replace(myArr(17), Chr$(34), vbNullString)
.Cells(lnglast, 35) = Replace(myArr(18), Chr$(34), vbNullString)
.Cells(lnglast, 36) = Replace(myArr(19), Chr$(34), vbNullString)
.Cells(lnglast, 38) = Replace(myArr(16), Chr$(34), vbNullString)
.Cells(lnglast, 39) = Replace(myArr(20), Chr$(34), vbNullString)
.Cells(lnglast, 40) = Replace(myArr(22), Chr$(34), vbNullString)
.Cells(lnglast, 3) = Replace(myArr(23), Chr$(34), vbNullString)
.Cells(lnglast, 7) = Replace(myArr(27), Chr$(34), vbNullString)
.Cells(lnglast, 5) = Replace(myArr(28), Chr$(34), vbNullString)
.Cells(lnglast, 6) = Replace(myArr(29), Chr$(34), vbNullString)
.Cells(lnglast, 16) = Replace(myArr(30), Chr$(34), vbNullString)
.Cells(lnglast, 22) = Replace(myArr(31), Chr$(34), vbNullString)
.Cells(lnglast, 23) = Replace(myArr(33), Chr$(34), vbNullString)
.Cells(lnglast, 31) =
"Objekt:"
&
" "
& Replace(myArr(34), Chr$(34), vbNullString) _
& vbCrLf &
"Objekthersteller:"
&
" "
& Replace(myArr(35), Chr$(34), vbNullString) _
& vbCrLf &
"Objektalter:"
&
" "
& Replace(myArr(36), Chr$(34), vbNullString) _
& vbCrLf &
"Trägermaterial:"
&
" "
& Replace(myArr(37), Chr$(34), vbNullString) _
& vbCrLf &
"Oberfläche:"
&
" "
& Replace(myArr(38), Chr$(34), vbNullString) _
& vbCrLf &
"Farbsystem-Nr.:"
&
" "
& Replace(myArr(39), Chr$(34), vbNullString) _
& vbCrLf &
"Glanzgrad:"
&
" "
& Replace(myArr(40), Chr$(34), vbNullString) _
& vbCrLf &
"Schadensumfang:"
&
" "
& Replace(myArr(40), Chr$(34), vbNullString) _
& vbCrLf &
"Schadensort:"
&
" "
& Replace(myArr(41), Chr$(34), vbNullString) _
& vbCrLf &
"Schadensursache:"
&
" "
& Replace(myArr(42), Chr$(34), vbNullString) & vbCrLf &
"Schadensbeschreibung:"
&
" "
& Replace(myArr(43), Chr$(34), vbNullString)
End
With
lnglast = lnglast + 1
End
If
End
If
End
Sub
Private
Sub
CommandButton1_Click()
Dim
Dateiname
As
Variant
Dateiname = Application.GetOpenFilename(filefilter:=
"Textdateien (*.csv), *.csv"
)
If
Dateiname <>
"Falsch"
Or
Dateiname <>
False
Then
Else
Exit
Sub
End
If
Call
ReadfromCSVSimple(Dateiname,
";"
)
Unload UserForm3
End
Sub
Private
Sub
CommandButton2_Click()
Unload
Me
UserForm4.Show
End
Sub
Private
Sub
CommandButton3_Click()
Unload
Me
End
Sub