vba 访问服务器文件,performance

感谢您的优化技巧，但是正如我所说，仅当我将数据库文件放在服务器上时，问题才会发生。 优化并没有太多帮助。 但是我想到了其他想法。

搜索空的空白“”将返回约40k条记录(这些记录涵盖了我需要的所有内容)。 因此，我将所有这些记录放在workbook_activate事件的不同工作表上，然后仅在该工作表中进行查询。

Sub Database_upload()

Application.DisplayAlerts = False

On Error Resume Next

Sheets("DATA_BASE").Delete

On Error GoTo 0

Application.DisplayAlerts = False

Sheets.Add

ActiveSheet.name = "DATA_BASE"

Sheets("DATA_BASE").Visible = False: Sheets("DARBALAUKIS").activate

Dim cnt As New ADODB.connection

Dim rcArray As Variant

Dim sSQL As String

Dim db_path As String, db_conn As String

Dim item As String

Dim qQt As QueryTable

item = "" 'search for empty blanks

sSQL = "Select Data, NomNr, Preke, Matas, Kaina, Tiek from VazPirkPrekes " & _

"Where VazPirkPrekes.PirkVazID IN (SELECT VazPirkimo.PirkVazID FROM VazPirkimo Where VazPirkimo.Sandelys like '%ALIAVOS')" & _

" and Year(VazPirkPrekes.Data)>=2011 and Preke Like '%" + item + "%' and Kaina > 0" & _

" Order by Preke, Data Desc"

db_path = Sheets("TMP").Range("B6").value

db_conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & db_path & ";"

db_conn = "ODBC;DSN=MS Access 97 Database;"

db_conn = db_conn & "DBQ=" & db_path

Set qQt = Sheets("Sheet1").QueryTables.Add(connection:=db_conn, Destination:=Sheets("Sheet1").Range("A1"), Sql:=sSQL)

qQt.Refresh BackgroundQuery:=False

End Sub

结果：

程序在启动时需要更长的时间，但是搜索时间是可以接受的-对我来说，问题已解决了:)