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

Automatically Close Excel Compatibility Checker window

提问by Jeremy F.

I have a VBA module that creates 2 Excel spreadsheets based on an MS Access temp table.

我有一个基于 MS Access 临时表创建 2 个 Excel 电子表格的 VBA 模块。

Each time a the second Excel spreadsheet is created, there is an Excel Compatibility Checker pop up window that appears. I am looking to automatically "click" 'Continue' on this pop up window each time the loop runs. How do I do this?

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

Refer to the section: 'Add step to click (Continue) button on pop-up windowin the code below

参考部分：'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

回答by Siddharth Rout

Try this

尝试这个

'
'~~> Rest of your code
'

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

'
'~~> Rest of your code
'

On a separate note. You are not specifying the FileFormatwhile saving? The syntax is

在单独的注释上。你没有指定FileFormat保存时？语法是

W.SaveAs FilePath, Fileformat:=FF

Where

在哪里

FilePathcan be something like "C:\MyFile.xls"and FFlike 56

FilePath可以像"C:\MyFile.xls"和FF像56

Here is a basic list of File Formats

这是文件格式的基本列表

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)

回答by Octavio

Try

尝试

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

Remember to set DisplayAlerts to true at some point in your code or Excel won't display any alerts.

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