我在一个打开Excel文件的Outlook项目中遇到过同样的问题，所以与其他人的猜测相反，它与数据库（ADO或DAO）技术没有直接关系。
关于Microsoft Knowledge Database：
症状
运行宏（该宏将包含受密码保护的VBA项目的工作簿的引用传递到ActiveX动态链接库（DLL））后，当Excel退出时，系统会提示您输入VBA项目密码。
原因
如果ActiveX DLL未正确释放对包含受密码保护的PLAN项目的工作簿的引用，则会发生此问题。
当对象之间存在循环引用，并且当Excel关闭时，如果对象保留对受保护工作簿的引用，则会出现密码提示时，通常会出现此问题。
范例：objectA存储对objectB的引用，objectB存储对objectA的引用。除非显式地set objectA.ReferenceToB = Nothing或objectB.ReferenceToA = Nothing，否则这两个对象不会被销毁。
由于我无法通过在我的计算机上运行您的代码来复制症状，我猜您已经修改了Stackoverflow的代码，以消除问题，例如通过在过程范围内重新定义公共变量。

这是一个间歇性地困扰我自己的Excel插件为少数客户的问题。我已经在我的在线文档中记录了这个问题：VB Password Prompt。
在为一个客户处理一个特定的情况时，我想出了一个解决方案。我不知道它是否只适用于他的情况（只适用于我的机器），或者它是否适用于更广泛的情况。
在Workbook_BeforeClose事件的末尾插入行“ThisWorkbook.Saved = True”：

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' blah blah before close code

    ThisWorkbook.Saved = True
End Sub

字符串
如果有人有机会尝试这个，你可以让我知道它是否对你和/或你的客户有帮助。

DAO不是从Excel文件中阅读数据的好平台。
实际上，所有可用的Microsoft数据库驱动程序技术都不是这样的-它们都有一些内存泄漏，而较旧的技术会创建Excel.exe的隐藏示例-因此VBA项目中的任何内容（例如，缺少的库或调用非编译代码的事件）都将引发某种错误，使Excel认为您正在尝试访问代码。
下面是一些使用ADODB的代码，ADODB是一种较新的数据库技术，可以解决DAO的任何特定问题。
我还没来得及把所有与您的请求无关的内容都去掉--抱歉，内容太多了！--但是，保留所有这些可选的连接字符串可能对您很有帮助：遇到此类问题的任何人都需要稍微考虑一下，并通过反复试验找出哪种技术是有效的：

Public Function FetchRecordsetFromWorkbook(ByVal SourceFile As String, _
                                           ByVal SourceRange As String, _
                                           Optional ReadHeaders As Boolean = True, _
                                           Optional StatusMessage As String = "", _
                                           Optional GetSchema As Boolean = False, _
                                           Optional CacheFile As String = "" _
                                           ) As ADODB.Recordset
Application.Volatile False

' Returns a static persistent non-locking ADODB recordset from a range in a workbook

' If your range is a worksheet, append "$" to the worksheet name. A list of the 'table'
' names available in the workbook can be extracted by setting parameter GetSchema=True

' If you set ReadHeaders = True the first row of your data will be treated as the field
' names of a table; this means that you can pass a SQL query instead of a range or table

' If you set ReadHeaders = False, the first row of your data will be treatd as data; the
' column names will be allocated automatically as 'F1', 'F2'...

' StatusMessage returns the rowcount if retrieval proceeds without errors, or '#ERROR'

' Be warned, the Microsoft ACE database drivers have memory leaks and stability issues

On Error GoTo ErrSub

Const TIMEOUT As Long = 60

Dim objConnect  As ADODB.Connection
Dim rst         As ADODB.Recordset
Dim strConnect  As String
Dim bFileIsOpen As Boolean

Dim objFSO As Scripting.FileSystemObject
Dim i           As Long

Dim TempFile    As String
Dim strTest     As String
Dim SQL         As String
Dim strExtension As String
Dim strPathFull As String
Dim timeStart As Single
Dim strHeaders As String
Dim strFilter  As String

If SourceFile = "" Then
    Exit Function
End If

' Parse out web folder paths
If Left(SourceFile, 5) = "http:" Then
    SourceFile = Right(SourceFile, Len(SourceFile) - 5)
    SourceFile = Replace(SourceFile, "%20", " ")
    SourceFile = Replace(SourceFile, "%160", " ")
    SourceFile = Replace(SourceFile, "/", "\")
End If

strPathFull = SourceFile

If Len(Dir(SourceFile)) = 0 Then
    Err.Raise 1004, APP_NAME & "GetRecordsetFromWorkbook", _
    "#ERROR - file '" & SourceFile & "' not found."
    Exit Function
End If

Set objFSO = FSO

strExtension = GetExtension(strPathFull)

bFileIsOpen = FileIsOpen(SourceFile)
If Not bFileIsOpen Then
    TempFile = objFSO.GetSpecialFolder(2).Path & "\" & TrimExtension(objFSO.GetTempName()) _
    & "." & strExtension
    objFSO.CopyFile SourceFile, TempFile, True
    SourceFile = TempFile
End If

If InStr(1, SourceRange, "SELECT", vbTextCompare) > 0 And _
    InStr(7, SourceRange, "FROM", vbTextCompare) > 1 Then
    strHeaders = "HDR=Yes"
ElseIf ReadHeaders = True Then
    strHeaders = "HDR=Yes"
Else
    strHeaders = "HDR=No"
End If

Select Case strExtension
Case "xls"

'strConnect = "ODBC;DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
' & "ReadOnly=1;DBQ=" & Chr(34) & SourceFile & Chr(34) & ";" _
' & ";Extended Properties=" &Chr(34) & "HDR=No;IMEX=1;MaxScanRows=0" & Chr(34) & ";"

'strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Chr(34) & SourceFile & _
' Chr(34) & ";Extended Properties=" & Chr(34) & "Excel 8.0;" & strHeaders _
' & ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"

strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chr(34) & SourceFile & _
Chr(34) & ";Persist Security Info=True;Extended Properties=" & _
Chr(34) & "Excel 8.0;" & strHeaders & ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"

 


Case "xlsx"

strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chr(34) & SourceFile & _
Chr(34) & ";Persist Security Info=True;Extended Properties=" & Chr(34) & _
"Excel 12.0 Xml;" & strHeaders & ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"

 


Case "xlsm"

'strConnect = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
' "ReadOnly=1;DBQ=" & SourceFile & ";" & Chr(34) & SourceFile & Chr(34) & ";" & _
' ";Extended Properties=" & Chr(34) & "Excel 12.0;" & strHeaders & _
' ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"

strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chr(34) & SourceFile & _
Chr(34) & ";Persist Security Info=True;Extended Properties=" & Chr(34) _
& "Excel 12.0 Macro;" & strHeaders & ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"

 


Case "xlsb"

'strConnect = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & "ReadOnly=1; _
' DBQ=" & SourceFile & ";" & Chr(34) & SourceFile & Chr(34) & ";" & _
' ";Extended Properties=" & Chr(34) & "Excel 12.0;" & strHeaders & _
' ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"

' This ACE driver is unstable on xlsb files... But it's more likely to return a result, if you don't mind crashes:

strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chr(34) & SourceFile & Chr(34) & _
";Persist Security Info=True;Extended Properties=" & Chr(34) & "Excel 12.0;" & _
strHeaders & ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"

 


Case Else
    Err.Raise 999, APP_NAME & "GetRecordsetFromWorkbook", "#ERROR - file format not known"
End Select

On Error GoTo ErrSub

'SetTypeGuessRows
timeStart = VBA.Timer
Set objConnect = New ADODB.Connection
With objConnect
.ConnectionTimeout = TIMEOUT
.CommandTimeout = TIMEOUT
.Mode = adModeRead

.ConnectionString = strConnect
.Open strConnect, , , adAsyncConnect

Do While .State > adStateOpen
    If VBA.Timer > timeStart + TIMEOUT Then
        Err.Raise -559038737, _
                  APP_NAME & " GetRecordsetFromWorkbook", _
                  "Timeout: the Excel data connection object did not respond in the " _
                  & TIMEOUT & "-second interval specified by this application."
        Exit Do
    End If
    If .State > adStateOpen Then Sleep 100
    If .State > adStateOpen Then Sleep 100
Loop

End With

Set rst = New ADODB.Recordset

timeStart = VBA.Timer

With rst

    .CacheSize = 8
    .PageSize = 8
    .LockType = adLockReadOnly

    If InStr(1, SourceRange, "SELECT", vbTextCompare) > 0 And _
       InStr(7, SourceRange, "FROM", vbTextCompare) > 1 Then
        SQL = SourceRange
    Else
        .MaxRecords = 8192

        SQL = "SELECT * FROM [" & SourceRange & "] "

        ' Exclude empty rows from the returned data using a 'WHERE' clause.
        With objConnect.OpenSchema(adSchemaColumns)
            strFilter = ""
            .Filter = "TABLE_NAME='" & SourceRange & "'"
            If .EOF Then
                .Filter = 0
                .MoveFirst
            End If
            Do While Not .EOF
                If UCase(!TABLE_NAME) = UCase(SourceRange) Then

                    Select Case !DATA_TYPE
                    Case 2, 3, 4, 5, 6, 7, adUnsignedTinyInt, adNumeric
                      ' All the numeric types you'll see in a JET recordset from Excel
                        strFilter = strFilter & vbCrLf & "    AND [" & !COLUMN_NAME & "] = 0 "
                    Case 130, 202, 203, 204, 205
                      ' Text and binary types that pun to vbstring or byte array
                        strFilter = strFilter & vbCrLf & "    AND [" & !COLUMN_NAME & "] = '' "
                    End Select

                    ' Note that we don't try our luck with the JET Boolean data type
                End If
            .MoveNext
            Loop
            .Close
        End With
        If strFilter <> "" Then
            strFilter = Replace(strFilter, vbCrLf & "    AND [", "  [", 1, 1)
            strFilter = vbCrLf & "WHERE " & vbCrLf & "NOT ( " & strFilter & vbCrLf & "    ) "
            SQL = SQL & strFilter
        End If
    End If

    .Open SQL, objConnect, adOpenForwardOnly, adLockReadOnly, adCmdText + adAsyncFetch

    i = 0
    Do While .State > 1

        i = (i + 1) Mod 3
        Application.StatusBar = "Retrieving data" & String(i, ".")
        If VBA.Timer > timeStart + TIMEOUT Then
            Err.Raise -559038737, _
                        APP_NAME & " Fetch data", _
                       "Timeout: the Excel Workbook did not return data in the " & _
                       TIMEOUT & "-second interval specified by this application."
            Exit Do
        End If

        If .State > 1 Then Sleep 100   ' There's a very slight performance gain doing it this way
        If .State > 1 Then Sleep 100

    Loop

End With

If rst.State = 1 Then

CacheFile = objFSO.GetSpecialFolder(2).Path & "\" & TrimExtension(objFSO.GetTempName()) & ".xml"
rst.Save CacheFile, adPersistXML    ' , adPersistADTG
rst.Close

End If

Set rst = Nothing
objConnect.Close
objConnect.Errors.Clear
Set objConnect = Nothing

Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.StayInSync = False

rst.Open CacheFile ', , adOpenStatic, adLockReadOnly, adCmdFile

StatusMessage = rst.RecordCount
Set FetchRecordsetFromWorkbook = rst

 


ExitSub:
On Error Resume Next

Set rst = Nothing
objConnect.Close
Set objConnect = Nothing

If (bFileIsOpen = False) And (FileIsOpen(SourceFile) = True) Then
For i = 1 To Application.Workbooks.Count
If Application.Workbooks(i).Name = Filename(SourceFile) Then
Application.Workbooks(i).Close False
Exit For
End If
Next i
End If

Exit Function

 


ErrSub:

StatusMessage = ""
StatusMessage = StatusMessage & ""
If InStr(Err.Description, "not a valid name") Then
StatusMessage = StatusMessage & "Cannot read the data from your file: "
StatusMessage = StatusMessage & vbCrLf & vbCrLf
StatusMessage = StatusMessage & Err.Description
StatusMessage = StatusMessage & vbCrLf & vbCrLf
StatusMessage = StatusMessage & "It's possible that the file has been locked, _
but the most likely explanation is that the file _
doesn't contain the named sheet or range you're _
trying to read: check that you've saved the _
correct range name with the correct file name."
StatusMessage = StatusMessage & vbCrLf & vbCrLf
StatusMessage = StatusMessage & "If this error persists, please contact the Support team."
MsgBox StatusMessage, vbCritical, APP_NAME & ": data access error:"
StatusMessage = "#ERROR " & StatusMessage

ElseIf InStr(Err.Description, "Could not find the object '& SourceRange") Then
StatusMessage = StatusMessage & ""
StatusMessage = StatusMessage & ""
StatusMessage = StatusMessage & ""
MsgBox Err.Description & vbCrLf & vbCrLf & "Please contact the Support team. _
This error probably means that source _
file is locked, or that the wrong file _
has been saved here: " & vbCrLf & vbCrLf & _
strPathFull, vbCritical, APP_NAME & ": file data error:"
StatusMessage = "#ERROR " & StatusMessage

ElseIf InStr(Err.Description, "Permission Denied") Then
StatusMessage = StatusMessage & "Cannot open the file: "
StatusMessage = StatusMessage & vbCrLf & vbCrLf
StatusMessage = StatusMessage & vbTab & Chr(34) & strPathFull & Chr(34)
StatusMessage = StatusMessage & vbCrLf & vbCrLf
StatusMessage = StatusMessage & "Another user probably has this file open. _
Please wait a few minutes, and try again. _
If this error persists, please contact Desktop team."
MsgBox StatusMessage, vbCritical, APP_NAME & ": file access error:"
StatusMessage = "#ERROR " & StatusMessage
Else
StatusMessage = StatusMessage & "#ERROR " & Err.Number & ": " & Err.Description
MsgBox StatusMessage, vbCritical, APP_NAME & ": file data error:"
End If

Resume ExitSub

 


' # leave this inaccessible statement in place for debugging:
    Resume

End Function

型
如果您在“_”拆分行周围遇到换行符问题，请深表歉意。
您还需要常量'APP_NAME'的声明：

PUBLIC CONST APP_NAME As String = "SQL Bluescreen demonstrator"

型
和“Sleep”函数的VBA API声明：

#If VBA7 And Win64 Then     ' 64 bit Excel under 64-bit windows: PtrSafe declarations and LongLong
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongLong)
#ElseIf VBA7 Then           ' VBA7 in a 32-bit environment:  PtrSafe declarations, but no LongLong
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else                       ' 32 bit Excel
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

型
在Microsoft Excel上运行SQL最好被认为是一件坏事：是的，SQL是迄今为止处理大量表格数据的最佳工具;但不，Microsoft不会很快修复这些内存泄漏。在雷德蒙，没有人对你试图在那里做什么感兴趣--当你可以购买一份MS-Access或SQL Server并将你的数据移植过来时，没有人感兴趣。
但是，如果您没有自己的SQL Server，而且在其他人的电子表格（或电子表格，复数形式）中有大量数据，那么这仍然是最好的解决方案。
So here's a Horrible Hack to read Excel with SQL的一个。
该条的副标题如下：

这是一个警示故事，讲述了开发人员不应该看到或做的事情，其中有商业逻辑的失败、变通办法和更坏的办法、预算精灵、商业分析师以及在电梯大厅寻求奇迹般治愈的淋巴结核朝圣者。

......你应该把它当作一个警告，告诉你将要面对的是什么：一场漫长而痛苦的代码争论，去做一些你可能本应该用其他方法去做的事情。

魔法！发送.xlsm附件到电子邮件。发送电子邮件给自己并下载附件。启动，启用Internet接收的内容，启用宏执行。问题消失。

我认为退出Excel时出现的密码输入窗口只发生在规格较低的计算机上。

的数据

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
 If Workbooks.Count = 1 Then
   Shell "Taskkill.exe /F /T /IM Excel.exe"
 End If
 
End Sub

字符串

如Miqi180所述，当没有正确清除对工作簿的引用时会出现此问题;请参阅Microsoft Knowledge Database
安装Office加载项时也可能发生此问题。存在一些已知问题：

• Acrobat PDFMaker COM Addin的
• 已在2011.0.1中修复
• Dropbox的
• 尚未修复; workaround
• 其他Addin？

在“引用”窗口中取消选中“OLE自动化”：

的数据