ADO 连接自身内存无法释放内存的一种解决方案

jiayw

最近需要学习的地方

学生甲1

好贴，学习了！

jiangwh15

谢谢!
谢谢版主,努力学习中!

jy1778492

终于找到了 ，不算晚！！谢谢了！！！

lingling327

querytable有同样的问题，还有一点就是退出EXCEL后，要计算一个CPU100%很久，EXCEL进程才关闭

LMY123

感谢版主的帮助，ADO学习中

kippon

好贴。收藏谢谢了。。。。

kippon

下面只对一个表操作，插入20000条数据后，大概70秒左右。
用DB将数据删除后，重新执行， 运行到Set Rst = ConnectRst(strSQL, "Postgre")就处于忙的状态。

    Call FunUpSpeedStart
    Application.DisplayAlerts = False
'    ThisWorkbook.Saved
    ThisWorkbook.ChangeFileAccess xlReadOnly

       For Each tablecell In Range(Replace(importRefEditValue, "$", ""))
            
            strTable = tablecell.Value
            
            Cells(tablecell.Row + 1, tablecell.Column).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            arr = Selection
            
            importProgressBar.Min = 1
            importProgressBar.Max = UBound(arr)
            
            For iRow = 1 To UBound(arr)
                strKeySQL = ""
                insertValues = ""
                For iCol = 1 To UBound(arr, 2)
                    ' Get data
                    insertValues = insertValues & "'" & arr(iRow + 1, iCol) & "',"
                Next
               
                ' Insert into DB
                strSQL = ""
                strSQL = "INSERT INTO " & strTable & " VALUES(" & Left(insertValues, Len(insertValues) - 1) & ")"

                Set Rst = ConnectRst(strSQL, "Postgre")
               
                'Disconnect from DB
                If Rst.State = 1 Then
                    Rst.Close
                    Set Rst = Nothing
                End If
                Cnn.Close
                Set Cnn = Nothing
               
                importProgressBar.Value = iRow
            Next
        Next

    Call FunUpSpeedEnd
    ThisWorkbook.ChangeFileAccess xlReadWrite
    Application.DisplayAlerts = True


Function ConnectRst(Sql As String, sqlType As String) As ADODB.Recordset
    Dim Cnn As New ADODB.Connection
    Dim Rst As New ADODB.Recordset
   
    On Error Resume Next
'    On Error GoTo l1
   
    Select Case sqlType
        Case "Excel"
            Cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;imex=1';data source=" & g_excel_file
        Case "Postgre"
            Cnn.Open "DRIVER={" & g_db_driver & "};SERVER=" & g_db_server & ";UID=" & g_db_uid & ";PWD=" & g_db_pwd & ";DATABASE=" & g_db_name & ";Connect Timeout=720"
    End Select
   
    Rst.Open Sql, Cnn, adOpenKeyset
   
    Set ConnectRst = Rst

End Function
谢谢指导。

kippon

求解答。谢谢了。

ldy

Cnn.Open "DRIVER={" & g_db_driver & "};SERVER=" & g_db_server & ";UID=" & g_db_uid & ";PWD=" & g_db_pwd & ";DATABASE=" & g_db_name & ";Connect Timeout=720"

字符串 处理问题
改为如下 前后 各加 两个引号
Cnn.Open """DRIVER={" & g_db_driver & "};SERVER=" & g_db_server & ";UID=" & g_db_uid & ";PWD=" & g_db_pwd & ";DATABASE=" & g_db_name & ";Connect Timeout=720"""

或者
s1= "DRIVER={" & g_db_driver & "};SERVER=" & g_db_server & ";UID=" & g_db_uid & ";PWD=" & g_db_pwd & ";DATABASE=" & g_db_name & ";Connect Timeout=720"
Cnn.Open s1