自动关闭Excel兼容性检查器窗口

Question

我有一个VBA模块，可以根据MS Access临时表创建2个Excel电子表格。

每次创建第二个Excel电子表格时，都会出现一个Excel兼容性检查器弹出窗口。我希望每次循环运行时在这个弹出窗口中自动“点击”“继续”。我该怎么做？

请参阅以下代码中的'Add step to click (Continue) button on pop-up window部分

Function ADMIN_Resource()
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Set cn = CurrentProject.Connection
Dim rowcount As Long
Dim tblcount As Integer
Dim i As Integer
DoCmd.SetWarnings False

'*****************************************************************************************************************************************************************
' Data pull from source ACCESS DB
'*****************************************************************************************************************************************************************

'On Error GoTo ErrorHandler

'Pull in all data from ACTUAL_ADMIN_TABLE into Main Temp Table
SQL = "SELECT Project_ID, Resource_ID, Allocation_Year, Jan, Feb, Mar, Apr, May, " & _
"Jun, Jul, Aug, Sep, Oct, Nov, Dec INTO tmp_ADMIN_TABLE FROM ACTUAL_ADMIN_TABLE ORDER BY Resource_ID ASC"
DoCmd.RunSQL SQL

'Add counter column to main temp table
SQL = "ALTER TABLE tmp_ADMIN_TABLE ADD COLUMN ID COUNTER(1,1)"
DoCmd.RunSQL SQL

'Set the number of files to create
SQL = "SELECT count(*) as rowcount from ACTUAL_ADMIN_TABLE"
rs.Open SQL, cn
rowcount = rs!rowcount
rs.Close
tblcount = rowcount / 500 + 1
For i = 1 To tblcount

'Create Sub Temp Table 
SQL = "SELECT * into tmp_ADMIN_TABLE" & i & " FROM tmp_ADMIN_TABLE" & _
" WHERE ID <=500*" & i
DoCmd.RunSQL SQL

'Delete ID column on Sub Temp Table
SQL = "ALTER TABLE tmp_ADMIN_TABLE" & i _
& " DROP COLUMN ID;"
DoCmd.RunSQL SQL

'Delete the top 500 records from Main Temp Table
SQL = "DELETE * FROM tmp_ADMIN_TABLE" & _
" WHERE ID <=500*" & i
DoCmd.RunSQL SQL

Dim strTable As String
Dim strWorksheetPath As String


'*****************************************************************************************************************************************************************
'Create RAW Data files (might not need this step)
'*****************************************************************************************************************************************************************

'Location of RAW Data file
strWorksheetPath = "C:\test\ADMIN_RSRC\"
'RAW Data file name
strWorksheetPath = strWorksheetPath & "RAW_ADMIN-" & i & ".xls"
'RAW Data file tab name
strTable = "tmp_ADMIN_TABLE" & i

'Command to create RAW data file using parameters from above
DoCmd.TransferSpreadsheet transfertype:=acExport, spreadsheettype:=acSpreadsheetTypeExcel9, TableName:=strTable, FileName:=strWorksheetPath, hasfieldnames:=True

'First set of error handling
'ErrorHandlerExit:
'    Exit Function
'    'Next i
'
'ErrorHandler:
'    MsgBox "Error No: " & Err.Number _
'    & "; Description: " & Err.Description
'    Resume ErrorHandlerExit


'*****************************************************************************************************************************************************************
'Create Second Excel file based on RAW Data file
'*****************************************************************************************************************************************************************

'Select data from temp table
Dim rss As New ADODB.Recordset
SQL = "SELECT * from tmp_ADMIN_TABLE" & i
rss.Open SQL, cn
'CurrentProject.Connection.Execute SQL

'Open new instance of Execl
Dim x As New Excel.Application
'Dim x as New evba
Dim w As Workbook
Dim s As Worksheet
Dim r As Range
Dim d As String
Dim e As String

'Template file name and location
d = "C:\test\UploadTemplate"

'Open Template file based on locaiton with the old Excel extension
Set w = workbooks.Open(d & ".xls")

'Open Specific Template tab
Set s = w.Sheets("Resource Tab")
'Range of Excel cells to load data to
Set r = s.Range("A3:O502")

'Copy records from ACCESS temp table to  Excel template document's specified locaiton
r.CopyFromRecordset rss

'Save Excel file
w.SaveAs d & i

'Add step to click (Continue) button on pop-up window
'*******************************************************************************
'RIGHT HERE 
'(This is where I need help closing the Excel - Compatibility Checker window)
'Any suggestions
'*******************************************************************************

'Close current record set
rss.Close

Set rss = Nothing

'Delete current ACCESS temp table
SQL = "DROP TABLE tmp_ADMIN_TABLE" & i
DoCmd.RunSQL SQL

ThisWorkbook.Saved = True

w.Close
x.Quit

Set r = Nothing
Set s = Nothing
Set w = Nothing
Set x = Nothing

'Second set of error handling
'ErrorHandlerExit:
'    Exit Function
'    'Next i

'ErrorHandler:
'    MsgBox "Error No: " & Err.Number _
'    & "; Description: " & Err.Description
'    Resume ErrorHandlerExit
'

Next i

'Delete the main temp table from ACCESS
SQL = "DROP TABLE tmp_ADMIN_TABLE"
DoCmd.RunSQL SQL

End Function

Answer 1

试试这个

'
'~~> Rest of your code
'

With W
    .CheckCompatibility = False
    .SaveAs d & i
    .Close
    .CheckCompatibility = True
End With

'
'~~> Rest of your code
'

单独说明。保存时您没有指定FileFormat？语法是

W.SaveAs FilePath, Fileformat:=FF

其中

FilePath可以是"C:\MyFile.xls"和FF，例如56

以下是文件格式的基本列表

50 = xlExcel12 (Excel Binary Workbook in 2007-2013 with or without macro's, xlsb)
51 = xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2013, xlsm)
56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)

Answer 2

尝试

Application.DisplayAlerts = False
' your code to create Excel spreadsheet
Application.DisplayAlerts = True

请记住在代码中的某个位置将DisplayAlerts设置为true，否则Excel将不会显示任何警报。