Option Explicit
Sub ImportCSV()
Dim shtImport As Worksheet
Dim strDelChar As String
Dim strFileName As String
Dim lRow As Long
Dim lCol As Long
Dim strText As String
Dim strChar As String * 1
Dim vntData As Variant
Dim lCharCount As Long
Const Zahl1 As Long = 1
Dim ZeileMax As Long
Dim ZeileMax1 As Long
Dim Row As Long
Dim rootDir As String
With Import
ZeileMax1 = .UsedRange.Rows.Count
For Row = ZeileMax1 To 4 Step -1
If Application.WorksheetFunction.CountA(.Rows(Row)) = 0 Then
.Rows(Row).Delete
End If
Next Row
End With
ZeileMax = Import.UsedRange.Rows.Count
ZeileMax = CDbl(Zahl1) + CDbl(ZeileMax)
Set shtImport = Sheets("Import")
strDelChar = ";"
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Select a CSV file!"
.Filters.Clear
.Filters.Add "Semicolon Separated Values", "*.csv"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "You did't select a CSV file!", vbExclamation, "Canceled"
Exit Sub
Else
strFileName = .SelectedItems(1)
End If
End With
Application.ScreenUpdating = False
If UCase(Right(strFileName, 3)) <> "CSV" Then
MsgBox "The file you select is not a CSV file!", vbCritical, "Error!"
Exit Sub
End If
On Error Resume Next
Open strFileName For Input As #1
If Err <> 0 Then
MsgBox "File not found: " & strFileName, vbCritical, "Error"
Exit Sub
End If
On Error GoTo 0
lRow = 0
lCol = 0
strText = ""
shtImport.Activate
Range("A" & ZeileMax).Activate
Do Until EOF(1)
Line Input #1, vntData
For lCharCount = 1 To Len(vntData)
strChar = Mid(vntData, lCharCount, 1)
If strChar = strDelChar Then
ActiveCell.Offset(lRow, lCol) = strText
lCol = lCol + 1
strText = ""
ElseIf lCharCount = Len(vntData) Then
If strChar <> Chr(34) Then strText = strText & strChar
ActiveCell.Offset(lRow, lCol) = strText
strText = ""
ElseIf strChar <> Chr(34) Then
strText = strText & strChar
End If
Next lCharCount
lCol = 0
lRow = lRow + 1
Loop
Close #1
Range("A3:E320000").Select
ActiveSheet.Range("$A$3:$E$320000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
Header:=xlYes
With Import
ZeileMax1 = .UsedRange.Rows.Count
For Row = ZeileMax1 To 4 Step -1
If Application.WorksheetFunction.CountA(.Rows(Row)) = 0 Then
.Rows(Row).Delete
End If
Next Row
End With
Application.ScreenUpdating = True
MsgBox "The file " & strFileName & " was successfully imported on sheet " & _
shtImport.Name & "!", vbInformation, "Done"
End Sub