为啥在 SQL 语言中使用 DAO 时 VBA 无法到达第 65,000 行之后的数据?
Posted
技术标签:
【中文标题】为啥在 SQL 语言中使用 DAO 时 VBA 无法到达第 65,000 行之后的数据?【英文标题】:Why does VBA doesn't reach data after Row number 65,000 when using DAO with SQL language?为什么在 SQL 语言中使用 DAO 时 VBA 无法到达第 65,000 行之后的数据? 【发布时间】:2021-09-01 07:37:09 【问题描述】:我有一个 VBA 模块,它接收一个数据库对象、工作表名称和两个列字段名称作为参数,以便对另一个具有超过 1,000,000 行信息的 Excel 表进行 SQL 查询。但是当我调试时,我注意到我的 VBA 代码在行号 65,000(大约)之后没有返回信息。这将返回错误信息,并且未按预期正常运行。
那么,如何在我现有的代码中处理它?
这是我的代码:
函数
Const diretoriosA = "C:\Users\Bosch-PC\Desktop\dbLEGENDAS_ELETROPAR\"
Const BaseEletro = "dbClientesEletropar.xlsb"
Const dbClientes = "CLIENTESLDA"
Public Function Number2Letter(ByVal ColNum As Long) As String
Dim ColumnNumber As Long
Dim ColumnLetter As String
ColumnNumber = ColNum
ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)
Number2Letter = ColumnLetter
End Function
Public Function GetWorkbook(ByVal sFullName As String) As Workbook
Dim sFile As String
Dim wbReturn As Workbook
sFile = DIR(sFullName)
On Error Resume Next
Set wbReturn = Workbooks(sFile)
If wbReturn Is Nothing Then
Set wbReturn = Workbooks.Open(sFullName)
End If
On Error GoTo 0
Set GetWorkbook = wbReturn
End Function
Public Function ReplaceChars(ByVal str As String, ByVal Lista As String) As String
Dim buff(), buffChars() As String
ReDim buff(Len(str) - 1): ReDim buffChars(Len(Lista) - 1)
For i = 1 To Len(str): buff(i - 1) = Mid$(str, i, 1): Next
For i = 1 To Len(Lista): buffChars(i - 1) = Mid$(Lista, i, 1): Next
For strEle = 0 To UBound(buff)
For listaEle = 0 To UBound(buffChars)
If buff(strEle) = buffChars(listaEle) Then
buff(strEle) = ""
End If
Next listaEle
novoTexto = novoTexto & buff(strEle)
Next strEle
ReplaceChars = novoTexto
End Function
Function ConsultaBaseDeDadosELETRO(ByVal CAMPO_PESQUISA As String, _
ByVal CAMPO_RETORNO As String, _
ByVal NOME_PLANILHA As String, _
ByRef BASES As Object, _
ByVal ARGUMENTO As String) As String
On Error GoTo ERRO:
Debug.Print BASES.Name
Dim RSt22 As Recordset
Set RSt22 = BASES.OpenRecordset("SELECT [" & CAMPO_RETORNO & "] FROM [" & NOME_PLANILHA & "$] WHERE [" & CAMPO_PESQUISA & "] IN ('" & ARGUMENTO & "') ;", dbOpenForwardOnly, dbReadOnly)
Debug.Print RSt22.CacheSize & " | CONTAGEM: " & RSt22.RecordCount
ConsultaBaseDeDadosELETRO = RSt22(CAMPO_RETORNO)
Exit Function
ERRO:
Debug.Print VBA.Err.Description & " | Error number: " & VBA.Err.Number & " | " & VBA.Err.HelpFile
ConsultaBaseDeDadosELETRO = "Sem registros"
End Function
主子程序
Sub ProcurarBaseEletro(ByVal PASTA As String, ByVal ARQUIVO As String, ByVal NOME_PLANILHA As String, ByVal CAMPO As String)
If ActiveCell.value = "CGC" Or ActiveCell.value = "CNPJ" Or ActiveCell.value = "cgc" Or ActiveCell.value = "cnpj" Then
Application.ScreenUpdating = False
Dim wks As Worksheet: Set wks = ActiveSheet
Dim db2 As database
Dim CellRow As Single
Dim Cellcol_info, CellCol As String
Dim DiretorioBase As String: DiretorioBase = diretorioSA & BaseEletro
Dim wb As Workbook: Set wb = GetWorkbook(DiretorioBase)
If wb Is Nothing Then
MsgBox "Base de dados não localizada!" & vbNewLine & "EM: " & DiretorioBase, vbCritical, "Atenção"
Set wb = Nothing
Set wks = Nothing
Application.ScreenUpdating = True
Exit Sub
Else
wks.Activate
CellRow = ActiveCell.row
CellCol = Number2Letter(ActiveCell.Column)
Cellcol_info = Number2Letter(ActiveCell.Column + 1)
CELLCOL_LROW = ActiveSheet.Cells(ActiveSheet.Rows.Count, CellCol).End(xlUp).row
Set db2 = OpenDatabase(DiretorioBase, False, False, "Excel 8.0")
Columns(Cellcol_info & ":" & Cellcol_info).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range(Cellcol_info & CellRow).value = CAMPO
Dim Query As String
Dim CelAtivaValue As String
For i = CellRow + 1 To CELLCOL_LROW
CelAtivaValue = UCase(Cells(i, CellCol).value)
Query = ReplaceChars(CelAtivaValue, "/.- ")
If Left(Query, 6) < 132714 Then
Cells(i, Cellcol_info).value = ConsultaBaseDeDadosELETRO("CGC", CAMPO, NOME_PLANILHA, db2, Query)
Else
Cells(i, Cellcol_info).value = ConsultaBaseDeDadosELETRO("CGC", CAMPO, NOME_PLANILHA & 2, db2, Query)
End If
Next i
wb.Close
End If
Else
MsgBox "Texto da Célula ativa não é CGC/CNPJ, impossível fazer pesquisa", vbCritical, "Valor célula ativa: " & ActiveCell.value
Application.ScreenUpdating = True
Exit Sub
End If
Cells.EntireColumn.AutoFit
MsgBox "Processo concluído com sucesso.", vbOKOnly, "Informativo do sistema"
Application.ScreenUpdating = True
End Sub
【问题讨论】:
听起来可能是驱动程序问题,旧版 Excel 中的最大行数为 65000 行,因此您可能需要使用不同的连接字符串或不同的连接字符串选项。跨度> 您将 Excel 8 指定为文件格式。该格式只能有 65536 行。 Rory,那还有什么办法呢? 您是否仍在使用旧版 Excel 工作簿 (.xls) 1997-2003?考虑以较新的格式保存工作簿 .xlsx (2007-2019) 和/或为OpenDatabase
使用较新的连接选项。见this answer。
【参考方案1】:
旧版 Excel 格式 (.xls) 的工作表限制为 2^16 (65536) 行。当前 Excel 格式 (.xlsx) 的工作表限制为 2^20 (1,048,576) 行。
您可能拥有更新版本的 MS Office (2007+)(给定 BaseEletro
中的 .xlsb),但您的 DAO 代码未更新。考虑将DAO.OpenDatabase
选项调整为较新的当前格式。
来自
Set db2 = OpenDatabase(DiretorioBase, False, False, "Excel 8.0")
到
Set db2 = OpenDatabase(DiretorioBase, False, False, "Excel 12.0 Xml")
【讨论】:
它显示以下消息:runtime error 3170 Could not find installable ISAM
。我目前正在使用 MSOFFICE 2007 顺便说一句。
你使用的是什么 DAO 库?检查 VB 编辑器,工具\参考。
Microsoft DAO 3.6 Object Library
请取消选中该引用并改为选中 Microsoft Office x.x Access database engine Object library
。这允许访问支持当前 Excel .xlsx 和 Access .accdb 格式的较新的 ACE 引擎。如果您没有此参考,请尝试安装此MS download,即使它适用于 Office 2010。Office 2007 和 2010 的 10 年支持结束已经过去。考虑升级以避免错误和安全问题。
是的,因为这个解决方案建议使用Excel 12.0 Xml
。以上是关于为啥在 SQL 语言中使用 DAO 时 VBA 无法到达第 65,000 行之后的数据?的主要内容,如果未能解决你的问题,请参考以下文章
SQL Server 存储过程向其调用者报告进度,一个 Access (VBA DAO) 传递查询
为啥sql数据库的表用VBA导到EXCEL中的速度比EXCEL的数据导入功能慢