加快此查找/筛选操作-（VB6、文本文件、ADO、VFP6.0数据库）

我正在想办法加快这项行动。在从文本文件导入记录之前，我首先需要查看数据库中是否存在记录。如果它确实存在，我将对它执行更新操作。如果它不存在，我将创建一个新记录

运行下面的代码这个操作大约需要3个小时

我尝试过使用ADO的find方法，实际上它似乎比filter方法慢

该数据库是一个Visual Foxpro 6数据库。该表在item_cd字段上有索引，但未建立任何主键。这是我无法控制的，因为我没有编写软件，我正试图避免对数据库进行任何结构更改

文本文件中有46652行，ADO记录集中约有650000条记录/行。我认为缩小记录集是解决这个问题的最大一步，但我还没有想出任何办法。我试图防止创建重复记录，因为没有主键，所以我真的需要在记录集中保存整个表

因为我在本地机器上运行这个，所以操作似乎受到CPU功率的限制。实际上，这可能会在整个网络中使用，特别是如果我能让它运行得更快的话

Dim sFileToImport As String
sFileToImport = Me.lstFiles.Text
If sFileToImport = "" Then
    MsgBox "You must select a file from the listbox to import."
    Exit Sub
End If

If fConnectToDatabase = False Then Exit Sub

With gXRst
    .CursorLocation = adUseClient
    .CursorType = adOpenKeyset
    .LockType = adLockReadOnly
    .Open "SELECT item_cd FROM xmsalinv ORDER BY item_cd ASC", gXCon
End With



Call fStartProgress("Running speed test.")

Dim rstTxtFile As ADODB.Recordset
Set rstTxtFile = New ADODB.Recordset
Dim con As ADODB.Connection
Set con = New ADODB.Connection

Dim sConString As String, sSQL As String
Dim lRecCount As Long, l As Long
Dim s As String

sConString = "DRIVER={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & gsImportFolderPath & ";Extensions=asc,csv,tab,txt;Persist Security Info=False;"
con.Open sConString

sSQL = "SELECT * FROM [" & sFileToImport & "]"

rstTxtFile.Open sSQL, con, adOpenKeyset, adLockPessimistic
If Not (rstTxtFile.EOF And rstTxtFile.BOF) = True Then
    rstTxtFile.MoveFirst
    lRecCount = rstTxtFile.RecordCount
    Do Until rstTxtFile.EOF = True

        'This code appears to actually be slower than the filter method I'm now using
        'gXRst.MoveFirst
        'gXRst.Find "item_cd = '" & fPQ(Trim(rstTxtFile(0))) & "'"

        gXRst.Filter = "item_cd = '" & fPQ(Trim(rstTxtFile(0))) & "'"
        If Not (gXRst.EOF And gXRst.BOF) = True Then
            s = "Item Found  -  " & Trim(rstTxtFile(0)) 'item found
        Else
           s = "Item Not Found  -  " & Trim(rstTxtFile(0)) 'Item not found found
        End If
        l = l + 1
        Call subProgress(l, lRecCount, s)
        rstTxtFile.MoveNext
    Loop
End If

Call fEndProgress("Finished running speed test.")

Cleanup:
    rstTxtFile.Close
    Set rstTxtFile = Nothing
    gXRst.Close

---

如果没有，请使用firehose光标显示VFP查询的结果，并查看此处的其他帖子，以获取有关文本文件记录集的建议

也许更好的是，你可以试着摆脱缓慢的“循环和搜索”模式

我可能会从头开始为每个要查找的文本文件创建一个临时Jet 4.0 MDB。导入文本数据，索引键字段。使用ADOX在VFP数据库中定义链接表。用户可以使用查询进行匹配

---

关闭MDB并在之后处理。

回应Bob Riemersma的帖子，文本文件不会导致速度问题。我已更改代码以打开一个记录集，其中包含一个查找单个项的查询。这段代码现在只需1分2秒就可以运行，而不是我刚才看到的3到4个小时

Dim sFileToImport As String
sFileToImport = Me.lstFiles.Text
If sFileToImport = "" Then
    MsgBox "You must select a file from the listbox to import."
    Exit Sub
End If

If fConnectToDatabase = False Then Exit Sub


Call fStartProgress("Running speed test.")

Dim rstTxtFile As ADODB.Recordset
Set rstTxtFile = New ADODB.Recordset
Dim con As ADODB.Connection
Set con = New ADODB.Connection

Dim sConString As String, sSQL As String
Dim lRecCount As Long, l As Long
Dim sngQty As Single, sItemCat As String

sConString = "DRIVER={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & gsImportFolderPath & ";Extensions=asc,csv,tab,txt;Persist Security Info=False;"
con.Open sConString

sSQL = "SELECT * FROM [" & sFileToImport & "]"

rstTxtFile.Open sSQL, con, adOpenKeyset, adLockPessimistic

If Not (rstTxtFile.EOF And rstTxtFile.BOF) = True Then
    rstTxtFile.MoveFirst
    lRecCount = rstTxtFile.RecordCount
    Do Until rstTxtFile.EOF = True
        l = l + 1
        sItemCat = fItemCat(Trim(rstTxtFile(0)))
        If sItemCat <> "[item not found]" Then
           sngQty = fItemQty(Trim(rstTxtFile(0)))
        End If
        Call subProgress(l, lRecCount, sngQty & " - " & sItemCat & " - " & rstTxtFile(0))
        sngQty = 0
        rstTxtFile.MoveNext
    Loop
End If

Call fEndProgress("Finished running speed test.")

Cleanup:
    rstTxtFile.Close
    Set rstTxtFile = Nothing

Dim sfileto作为字符串导入
sFileToImport=Me.lstFiles.Text
如果sFileToImport=“”，则
MsgBox“必须从列表框中选择要导入的文件。”
出口接头
如果结束
如果fConnectToDatabase=False，则退出Sub
调用fStartProgress（“运行速度测试”）
Dim rstTxtFile作为ADODB.Recordset
Set rstTxtFile=New ADODB.Recordset
Dim con作为ADODB连接
Set con=New ADODB.Connection
Dim SCONSSTRING作为字符串，sSQL作为字符串
暗淡的l等于长，l等于长
尺寸sngQty为单个，sItemCat为字符串
sConString=“DRIVER={Microsoft文本驱动程序（*.txt；*.csv）}；Dbq=“&gsImportFolderPath&”扩展名=asc，csv，tab，txt；持久安全信息=False；”
反对公开辩论
sSQL=“从[”&sFileToImport&“]中选择*”
rstTxtFile.Open sSQL、con、adOpenKeyset、adlock悲观
如果不是（rstTxtFile.EOF和rstTxtFile.BOF）=True，则
rstTxtFile.MoveFirst
lRecCount=rstTxtFile.RecordCount
直到rstTxtFile.EOF=True为止
l=l+1
sItemCat=fItemCat（Trim（rstTxtFile（0）））
如果sItemCat“[未找到项]”则
sngQty=fItemQty（修剪（rstTxtFile（0）））
如果结束
调用子gress（l、lRecCount、sngQty&“-”&sItemCat&“-”&rstTxtFile（0））
sngQty=0
rstTxtFile.MoveNext
环
如果结束
调用fEndProgress（“完成运行速度测试”）
清理：
rstTxtFile.Close
设置rstTxtFile=Nothing

我的职能：

Private Function fItemCat(sItem_cd As String) As String

    'Returns blank if nothing found

    If sItem_cd <> "" Then

        With gXRstFind
            .CursorLocation = adUseClient
            .CursorType = adOpenKeyset
            .LockType = adLockReadOnly
            .Open "SELECT item_cd, ccategory FROM xmsalinv WHERE item_cd = '" & fPQ(sItem_cd) & "'", gXCon
        End With
        If Not (gXRstFind.EOF And gXRstFind.BOF) = True Then
            'An item can technically have a blank category although it never should have
            If gXRstFind!ccategory = "" Then
                fItemCat = "[blank]"
            Else
                fItemCat = gXRstFind!ccategory
            End If
        Else
           fItemCat = "[item not found]"
        End If
        gXRstFind.Close
    End If

End Function

Private Function fIsStockItem(sItem_cd As String, Optional bConsiderItemsInStockAsStockItems As Boolean = False) As Boolean

    If sItem_cd <> "" Then

        With gXRstFind
            .CursorLocation = adUseClient
            .CursorType = adOpenKeyset
            .LockType = adLockReadOnly
            .Open "SELECT item_cd, bal_qty, sug_qty FROM xmsalinv WHERE item_cd = '" & fPQ(sItem_cd) & "'", gXCon
        End With
        If Not (gXRstFind.EOF And gXRstFind.BOF) = True Then
            If gXRstFind!sug_qty > 0 Then
                fIsStockItem = True
            Else
                If bConsiderItemsInStockAsStockItems = True Then
                    If gXRstFind!bal_qty > 0 Then
                        fIsStockItem = True
                    End If
                End If
            End If
        End If
        gXRstFind.Close
    End If

End Function


Private Function fItemQty(sItem_cd As String) As Single

    'Returns 0 if nothing found

    If sItem_cd <> "" Then

        With gXRstFind
            .CursorLocation = adUseClient
            .CursorType = adOpenKeyset
            .LockType = adLockReadOnly
            .Open "SELECT item_cd, bal_qty FROM xmsalinv WHERE item_cd = '" & fPQ(sItem_cd) & "'", gXCon
        End With
        If Not (gXRstFind.EOF And gXRstFind.BOF) = True Then
            fItemQty = CSng(gXRstFind!bal_qty)
        End If
        gXRstFind.Close
    End If

End Function

私有函数fItemCat（sItem\u cd作为字符串）作为字符串
'如果未找到任何内容，则返回空白
如果是“光盘”，则
使用gXRstFind
.CursorLocation=adUseClient
.CursorType=adOpenKeyset
.LockType=adLockReadOnly
.打开“从xmsalinv中选择项目光盘，C目录，其中项目光盘=”&fPQ（站点光盘）和“”，gXCon
以
如果不是（gXRstFind.EOF和gXRstFind.BOF）=True，则
“从技术上讲，一个项目可以有一个空白类别，尽管它永远不应该有
如果gXRstFind！ccategory=”“然后
fItemCat=“[blank]”
其他的
fItemCat=gXRstFind！分类
如果结束
其他的
fItemCat=“[item not found]”
如果结束
gXRstFind.关闭
如果结束
端函数
私有函数fIsStockItem（sItem_cd为字符串，可选bconSiderItemInstackAsTockItems为Boolean=False）为Boolean
如果是“光盘”，则
使用gXRstFind
.CursorLocation=adUseClient
.CursorType=adOpenKeyset
.LockType=adLockReadOnly
打开“从xmsalinv中选择项目cd、余额数量、建议数量，其中项目cd=”&fPQ（站点cd）&“”，gXCon
以
如果不是（gXRstFind.EOF和gXRstFind.BOF）=True，则
如果gXRstFind！sug_数量>0然后
fIsStockItem=True
其他的
如果bConsiderItemInstackAsstockItems=True，则
如果gXRstFind！余额数量>0时
fIsStockItem=True
如果结束
如果结束
如果结束
如果结束
gXRstFind.关闭
如果结束
端函数
私有函数fItemQty（sItem\u cd作为字符串）作为单个
'如果未找到任何内容，则返回0
如果是“光盘”，则
使用gXRstFind
.CursorLocation=adUseClient
.CursorType=adOpenKeyset
.LockType=adLockReadOnly
.打开“从xmsalinv中选择项目cd，结存数量，其中项目cd=”，以及gXCon的fPQ（现场cd）和“”
以
如果不是（gXRstFind.EOF和gXRstFind.BOF）=True，则
fItemQty=CSng（gXRstFind！结存数量）
如果结束
gXRstFind.关闭
如果结束
端函数

首先，您可以尝试使用

Set cIndex = New Collection
On Error Resume Next
Do While Not gXRst.EOF
    cIndex.Add gXRst.Bookmark, "#" & gXRst!item_cd.Value
    gXRst.MoveNext
Loop
On Error GoTo ErrorHandler

Public Function SearchCollection(Col As Object, Index As Variant) As Boolean
    On Error Resume Next
    IsObject Col(Index)
    SearchCollection = (Err.Number = 0)
    On Error GoTo 0
End Function