Private Sub NeuerPreis()
On Error GoTo ErrHandler
Dim i As Long
' Alle selektierten Artikel der aktuellen Warengruppen durchlaufen
    ProgressBar.Max = grdShop.SelCount
 
    Select Case vEK_Select
    ' niedrigster Einkaufspreis 
    ' -------------------------------------------------------------------------
    ' -------------------------------------------------------------------------
    ' ----
      Case 1
        ' sqlID = 2 - Nur lieferbare Artikel der Lieferanten anzeigen!
        sqlID = 2: Call SQL_Filter ' = SQL Abfrage - wird weiter unten ins 
        ' Recorset eingefügt
    ' durchschnittswert ermitteln 
    ' -------------------------------------------------------------------------
    ' -------------------------------------------------------------------------
    ' --
      Case 2
 
    ' höchster Einkaufspreis 
    ' -------------------------------------------------------------------------
    ' -------------------------------------------------------------------------
    ' -------
      Case 3
 
    End Select
 
    For i = 1 To grdShop.SelCount
        If vAbbruch = "Y" Then Exit Sub
        vProdukt_PKID = grdShop.Text(i, 3)
        vProductEAN = grdShop.Text(i, 4)
        vProductID = grdShop.Text(i, 4)
        vProdukt_Aufschlag = grdShop.Text(i, 6)
        vProduct_ArtNr = grdShop.Text(i, 8)
        ' Lieferstatus zurücksetzen
        vIstLieferbar = False: vLfStatusText = "": vDeliveryTimePKID = ""
 
        ' EAN Nummer bis 13 Zeichen auffüllen
        Call GetLengthEAN: vProductEAN = Trim("*" & vProductEAN & "*")
        ' falls eine Raute in der EAN/Herstellernummer enthalten ist wird sie 
        ' mit '[#]' ersetzt, sonst wird der Artikel nicht gefunden
        strText = Trim(vProductID): vSearch = "#": vReplace = "[#]": vProductID _
          = Replace(strText, vSearch, vReplace)
        ' SQL Text auswählen und in die SQL Anweisung importieren, vEK_Select: 
        ' 1 = niedrigster, 2 = Durchschnitt, 3 = höchster Preis
 
        Set oRs = oDB_ProjektDB.OpenRecordset(sqlText_Filter)
 
        ' Einkaufspreis und Lieferstatus an die Variablen übergeben und ggf. 
        ' formatieren falls der EK Preis leer ist
        If vEK_Select = 1 Or vEK_Select = 3 Then
            vEkPreis = Format(oRs.Fields("fld_EK").Value, "##.00 €"): If _
              vEkPreis = "" Then vEkPreis = "0,00 €"
            vIstLieferbar = oRs.Fields("fld_Status").Value: vLfStatusText = _
            oRs.Fields("fld_Inhalt").Value
        End If
 
        ' ProductID, ProduktName, neuer Ek, Aufschlag, alter VK, neuer Vk, 
        ' lieferstatus
        ' Artikel aktualisieren
        Call UpdateProdukt
        If vIstLieferbar = True Then
            lstProtokoll.AddItem vProduct_ArtNr & vbTab & _
            grdShop.Text(i, 9) & vbTab & _
            vEkPreis & vbTab & _
            vProdukt_Aufschlag & vbTab & _
            grdShop.Text(i, 7) & vbTab & _
            vNewVkPreis & vbTab & _
            vLfStatusText
        End If
        If vIstLieferbar = False Then
            lstProtokoll.AddItem vProduct_ArtNr & vbTab & _
            grdShop.Text(i, 9) & vbTab & _
            grdShop.Text(i, 5) & vbTab & _
            grdShop.Text(i, 6) & vbTab & _
            grdShop.Text(i, 7) & vbTab & _
            grdShop.Text(i, 7) & vbTab & _
            vLfStatusText '"Liefertermin unbekannt"
        End If
'         Fortschrittsanzeige aktualisieren
        sRow = sRow + 1: lstProtokoll.Row = sRow: ProgressBar.Value = i
        DoEvents
    Next
 
Exit Sub
ErrHandler:
    Screen.MousePointer = vbDefault
    Select Case Err.Number
      Case 0
        Resume Next
      Case -2147217913
        Resume Next
      Case -2147467259
        answ = MsgBox(Err.Description & vbNewLine & vbNewLine & "Erneuter" & _
          "Verbindungsversuch?", vbCritical + vbYesNo, "Datenbankmanager")
        If answ = vbYes Then Resume Next Else Unload Me: Exit Sub
      Case 3021
        vIstLieferbar = False: Resume Next
    Case Else
        MsgBox Err.Description, vbCritical + vbOKOnly, "Fehlernummer : " & _
          Me.Caption & "" & Err.Number: Exit Sub
    End Select
End Sub