Public Sub subDBDataImport()
 
Dim sSQL As String
Dim sSQLUpdFields As String
Dim sSQLSearchFields As String
Dim sSQLDBFields As String
Dim sFilt() As String
Dim sAnfügeFeld() As String
Dim sSuchKriterium() As String
Dim sSQLOrderBy As String
Dim sFilter As String
Dim bUpd As Boolean
Dim rs As New ADODB.Recordset
 
On Error GoTo Err_Handl
 
 
frmDIR_STAM_Import.MousePointer = vbHourglass
 
With frmDIR_STAM_Import.grd_dbf
    'ermitteln welche spalten angefügt werden müssen
    For i = 1 To .Rows
        If .ListItems(i).CellText(2) <> "" Then
            sSQLUpdFields = sSQLUpdFields & i & IIf(i < .Rows, vbCrLf, "")
        End If
    Next i
 
    For i = 1 To .Rows
        If .ListItems(i).CellText(2) <> "" Then
             sSQLDBFields = sSQLDBFields & .ListItems(i).CellText(2) & IIf(i < _
               .Rows, vbCrLf, "")
        End If
    Next i
    'spalten zeilenweise auslesen
    Erase sFilt
    sFilt = Split(sSQLUpdFields, vbCrLf, , vbTextCompare)
    sSQLUpdFields = vbNullString
    sAnfügeFeld = Split(sSQLDBFields, vbCrLf, , vbTextCompare)
    sSQLDBFields = vbNullString
 
 
Dim xIndex As Integer
xIndex = vbEmpty
For i = 1 To frmDIR_STAM_Import.grd_srch.Rows
    If i <= .Rows Then
        If .ListItems(i).CellText(1) <> vbNullString Then
        xIndex = xIndex + 1
        End If
    End If
 
    If frmDIR_STAM_Import.grd_srch.ListItems(i).CellText(2) <> "" And _
      frmDIR_STAM_Import.grd_srch.ListItems(i).CellText(3) <> "" Then
    sSQLSearchFields = sSQLSearchFields & IIf(sSQLSearchFields <> _
    vbNullString, vbCrLf, "") & xIndex & ";" & _
    frmDIR_STAM_Import.grd_srch.ListItems(i).CellText(2)
    End If
Next i
End With
 
sSuchKriterium = Split(sSQLSearchFields, vbCrLf, , vbTextCompare)
sSQLSearchFields = vbNullString
 
    'Datenbankfelder ermitteln
    For i = LBound(sAnfügeFeld) To UBound(sAnfügeFeld)
    sSQLDBFields = sSQLDBFields & RTrim(sAnfügeFeld(i)) & ","
    Next i
 
    'letztes satzzeichen entfernen
    sSQLDBFields = fnClearDelimeter(sSQLDBFields, ",")
    If (Not Not sSuchKriterium) <> 0 Then
    sSQL = "UPDATE " & frmDIR_STAM_Import.sDB & " SET "
    Else
    sSQL = "INSERT IGNORE INTO " & frmDIR_STAM_Import.sDB & " (" & sSQLDBFields _
      & ") VALUES ("
    End If
    sSQLDBFields = vbNullString
 
    'Order BY
    sSQLOrderBy = vbNullString
    For i = 1 To frmDIR_STAM_Import.grd_srch.Rows
    If frmDIR_STAM_Import.grd_srch.Text(i, 4) <> vbNullString Then _
      sSQLOrderBy = sSQLOrderBy & frmDIR_STAM_Import.grd_srch.Text(i, 2) & " " _
      & frmDIR_STAM_Import.grd_srch.Text(i, 4) & ","
    Next i
    'letztes satzzeichen entfernen
    If sSQLOrderBy <> vbNullString Then sSQLOrderBy = "ORDER BY " & _
      fnClearDelimeter(sSQLOrderBy, ",")
 
'werte aus der imp anhand des gestzten filters ermitteln
For a = 1 To frmDIR_STAM_Import.grd_imp.Rows
    If (Not Not sSuchKriterium) <> 0 Then
            'QuelldateiFelder ermitteln
            For i = LBound(sFilt) To UBound(sFilt)
                If frmDIR_STAM_Import.grd_imp.Text(a, CInt(sFilt(i))) <> _
                  vbNullString Then _
                sSQLUpdFields = sSQLUpdFields & RTrim(sAnfügeFeld(i)) & "='" & _
                frmDIR_STAM_Import.grd_imp.Text(a, CInt(sFilt(i))) & "',"
            Next i
            'letztes satzzeichen entfernen
            sSQLUpdFields = fnClearDelimeter(sSQLUpdFields, ",")
 
            If sSQLUpdFields = vbNullString Then GoTo NextLine
    Else
            'QuelldateiFelder ermitteln
            For i = LBound(sFilt) To UBound(sFilt)
            sSQLUpdFields = sSQLUpdFields & "'" & _
              frmDIR_STAM_Import.grd_imp.Text(a, CInt(sFilt(i))) & "',"
            Next i
            'letztes satzzeichen entfernen
            sSQLUpdFields = fnClearDelimeter(sSQLUpdFields, ",")
 
            If sSQLUpdFields = vbNullString Then GoTo NextLine
            'Quelldaten anfügen
            sSQLUpdFields = sSQLUpdFields & ")"
    End If