Office 365 Access VBA DoCmd.TransferText 3051错误求助

我在Windows 11机器上运行Office 365，创建了一个Access数据库，通过模块、宏以及导入导出规范从CSV文件加载表、运行两个查询并生成CSV格式的报告文件，原版本运行正常。

现需修改CSV报告，移除不必要的列。我仅修改了生成报告的查询（移除冗余列）和导出规范，删除目录中的CSV文件并重启Access后，右键查询导出可正常生成CSV，但运行模块时仅写入表头记录，并触发以下错误：

CreatePerlReport 3051: The Microsoft access database engine cannot open or write to the file 'Perl_Split_20251031.csv'. It is already opened exclusively by another user, or you need permission to view and write its data.

Public Function CreatePerlReport()
    On Error GoTo Error_Routine

'Declare variables
    Dim dtGetCurrentDate        As Date                 'Use the date function
    Dim intErrCount             As Integer              'Error handling switch
    Dim strReportDate           As String               'Date in YYYYMMDD format to be added to perl report name
    Dim strQuery                As String               'Variable for SQL query statement
    Dim strQueryName            As String               'Variable for query name
    Dim strFilePath1            As String               'Variable for the backup location that the CSV file will be stored in
    Dim strFilePath2            As String               'Variable for the primary location that the CSV file will be stored in
    Dim strFileName             As String               'Variable for the CSV file name
    Dim strSpecName             As String               'Varaiable for the export specification
    Dim LogMessage              As String               'Variable for error message displayed in logfile
    Dim dbs                     As DAO.Database         'Current database
    Dim rst                     As DAO.Recordset        'Current recordset
    Dim qdf                     As DAO.QueryDef         'Current query
    
' --- Configuration ---
    strReportDate = Format(Date, "yyyymmdd")
    intErrCount = 0
' --- End Configuration ---
     
'Select EPICUNK Report query parameters
    strQuery = "SELECT Format(Date(),'yyyymmdd') AS [SPLIT DATE], Original_Results.FILENAME, EPICUNK_Results.ST02, " _
                & "IIf(IsNull([Original_Results]![TIN]),[Original_Results]![NPI],[Original_Results]![TIN]) AS TIN, Original_Results.NPI, " _
                & "Original_Results.PAYERNAME, Original_Results.[PMT TYPE], Original_Results.[CHECK NUMBER], Original_Results.[CHECK DATE], " _
                & "Original_Results.[CHECK AMOUNT], [Original_Results]![CHECK AMOUNT]-[EPICUNK_Results]![CHECK AMOUNT] AS [VARIANCE/UNK POSTED TO EPIC], " _
                & "EPICUNK_Results.[CHECK AMOUNT] AS [UNK PROCEESED IN EPIC FH-IN REMIT WQ] " _
            & "FROM Original_Results LEFT JOIN EPICUNK_Results ON Original_Results.[CHECK NUMBER] = EPICUNK_Results.[CHECK NUMBER];"

'Delete old EPICUNK Report query results if the query exists. Then insert the new query results.
    Set dbs = CurrentDb()
    For Each qdf In dbs.QueryDefs
        If qdf.Name = "EPICUNK_Report" Then
            dbs.QueryDefs.Delete "EPICUNK_Report"
            Exit For
        End If
    Next
    Set rst = dbs.OpenRecordset(strQuery, dbOpenSnapshot)
    With dbs
        Set qdf = .CreateQueryDef("EPICUNK_Report", strQuery)
    End With
'Select Perl Report query parameters
    strQuery = "SELECT DISTINCT Format(Date(),'yyyymmdd') AS [SPLIT DATE], Original_Results.FILENAME, Original_Results.ST02, " _
                & "IIf(IsNull([Original_Results]![TIN]),[Original_Results]![NPI],[Original_Results]![TIN]) AS TIN, " _
                & "Original_Results.NPI AS [TIN/NPI], Original_Results.PAYERNAME, Original_Results.[PMT TYPE], Original_Results.[CHECK NUMBER], " _
                & "Original_Results.[CHECK AMOUNT], Null AS VARIANT, Original_Results.[CHECK AMOUNT] AS [EPIC FH], " _
                & "EPICUNK_Report.[UNK PROCEESED IN EPIC FH-IN REMIT WQ], Null AS [VARIANCE/UNK POSTED TO EPIC FH], Null AS [EPIC FH BATCH NUM] " _
             & "FROM (Original_Results " _
                & "LEFT JOIN EPICFH_Results ON (Original_Results.ST02 = EPICFH_Results.ST02) " _
                   & "AND (Original_Results.[CHECK NUMBER] = EPICFH_Results.[CHECK NUMBER]) AND (Original_Results.[CHECK DATE] = EPICFH_Results.[CHECK DATE])) " _
                & "LEFT JOIN EPICUNK_Report ON (Original_Results.ST02 = EPICUNK_Report.ST02) " _
                   & "AND (Original_Results.[CHECK NUMBER] = EPICUNK_Report.[CHECK NUMBER]) AND (Original_Results.[CHECK DATE] = EPICUNK_Report.[CHECK DATE]);"

'Delete old Perl Report query results if the query exists. Then insert the new query results.
    For Each qdf In dbs.QueryDefs
        If qdf.Name = "Perl_Split" Then
            dbs.QueryDefs.Delete "Perl_Split"
            Exit For
        End If
    Next
    Set rst = dbs.OpenRecordset(strQuery, dbOpenSnapshot)
    With dbs
        Set qdf = .CreateQueryDef("Perl_Split", strQuery)
    End With
    
'Perl Report CSV file and paths configuration
    strQueryName = "Perl_Split"
    strFileName = strQueryName & "_" & strReportDate & ".csv"
    strFilePath1 = "Z:\Production\IDX\Perl_Split_835_Files\BALANCER_REPORT\"
    'strFilePath2 = "L:\CPS_PB_BillingCollectionsReimbursement\03_Cashiering-Posting-Recon\3_Reconciliation\835 EDI Perl Split Reports\"
    strSpecName = "Perl Split Export Specs"
        
'Send semicolon delimited CSV file to the backup and primary location
    DoCmd.TransferText acExportDelim, strSpecName, strQueryName, strFilePath1 & strFileName, True
    'DoCmd.TransferText acExportDelim, strSpecName, strQueryName, strFilePath2 & strFileName, True
    
'Send email to operations and CPS balancers
    MsgBox "Make sure Outlook is open in the rdp session before pressing OK."
    Call SendOutlookEmail(strFileName)
    
'Display end of module message
    MsgBox "The Perl Split Report csv file was created and email sent. Press OK to continue."
           
'Closing database variables
Exit_Routine:
    strQuery = ""
    rst.Close
    qdf.Close
    dbs.Close
    
'Exiting function and returning control to Access
    Set rst = Nothing
    Set qdf = Nothing
    Set dbs = Nothing
    
'Determine ending log statement
    If intErrCount = 0 Then
        LogMessage = "Create Perl Report macro completed successfully."
    Else
        LogMessage = "Create Perl Report macro completed."
    End If
    Call LogToFile(LogMessage)
    
Exit Function

' Save error message to the logfile and display it.
Error_Routine:
    intErrCount = 1
    LogMessage = "  Error in CreatePerlReport " & "Error Number:" & Err.Number & " Description:" & Err.Description
    Call LogToFile(LogMessage)
    MsgBox "CreatePerlReport" & Err.Number & ": " & Err.Description, vbCritical
    Resume Exit_Routine
End Function

• 及时释放记录集资源：代码中创建查询时打开的rst记录集未及时关闭，导致资源泄漏，可能锁定查询或文件。修改代码，在创建完每个查询后立即关闭对应记录集：

  ' 创建EPICUNK_Report查询后添加
  rst.Close
  Set rst = Nothing
  
  ' 创建Perl_Split查询后添加
  rst.Close
  Set rst = Nothing
  

• 校验导出规范匹配度：修改查询列后，导出规范Perl Split Export Specs的字段映射可能与新查询不匹配，导致导出中断仅生成表头。打开导出规范，确认字段数量、名称和顺序与Perl_Split查询完全一致。
• 导出前强制删除旧文件：手动删除文件后可能存在系统进程占用文件句柄的情况，导出前通过代码删除旧文件：

  ' 在DoCmd.TransferText前添加
  Dim fullExportPath As String
  fullExportPath = strFilePath1 & strFileName
  If Dir(fullExportPath) <> "" Then
      Kill fullExportPath
  End If
  

• 调整DAO对象释放逻辑：QueryDef和CurrentDb()无需调用Close方法，直接释放对象即可，避免错误。修改Exit_Routine段代码：

  Exit_Routine:
      strQuery = ""
      ' 先关闭记录集（如果未关闭）
      If Not rst Is Nothing Then
          If rst.State = dbOpenSnapshot Then rst.Close
          Set rst = Nothing
      End If
      ' 释放查询定义
      If Not qdf Is Nothing Then
          Set qdf = Nothing
      End If
      ' 释放数据库对象
      If Not dbs Is Nothing Then
          Set dbs = Nothing
      End If
  

内容的提问来源于stack exchange，提问作者TomJ