VBA 对象在使用另存为功能时不支持此属性或方法

Question

我在SaveAs行上收到一个错误"Object不支持此属性或方法">

Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open ("s:CommonTemplate.xlsx")
xl.Visible = True
xl.Sheets("Data").Visible = True
xl.Sheets("Data").Select
xl.Range("A1").Select
xl.Range("Table_CBA_Group_Tiered_Inputs.accdb[[#Headers],[ACTIVITY_DT]]").Select
xl.Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
xl.Worksheets("Fname").Visible = True
xl.Sheets("Fname").Select

Application.DisplayAlerts = False
Path = "S:Common"
Filename = xl.Sheets("Fname").Range("A7").Value
xl.SaveAs Path & Filename & ".xlsx"
xl.Close
Application.DisplayAlerts = True

Answer 1

试试这个：

编辑-从您更新的帖子中更新。。。

Dim xl, wb, Path, fName
Set xl = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Open("s:CommonTemplate.xlsx")
xl.Visible = True
wb.Sheets("Data").Visible = True
wb.Sheets("Data").ListObjects( _
"Table_CBA_Group_Tiered_Inputs.accdb").Refresh BackgroundQuery:=False
wb.Worksheets("Fname").Visible = True
wb.Sheets("Fname").Select
Application.DisplayAlerts = False 'this doesn't affect your `xl` instance...
Path = "S:Common"
fName = wb.Sheets("Fname").Range("A7").Value
xl.SaveAs Path & fName & ".xlsx"
xl.Close
Application.DisplayAlerts = True 'see above...
'xl.Quit

Answer 2

Excel的新实例

• 打开Excel的一个新的"不可见"实例。在其中，它打开一个工作簿，运行一个查询，并用不同的名称保存工作簿。关闭工作簿和Excel实例
• 如果没有消息框，就好像什么都没发生一样
• 未经测试

代码

Option Explicit
Sub testNewApp()

Const FolderPath As String = "S:Common"
Const trgAddress As String _
= "Table_CBA_Group_Tiered_Inputs.accdb[[#Headers],[ACTIVITY_DT]]"

Dim Success As Boolean

On Error GoTo NewAppError
With New Application
'.Visible = False ' False is default.
With .Workbooks.Open(FolderPath & "Template.xlsx")
With .Worksheets("Data")
.Visible = xlSheetVisible
.Range(trgAddress).ListObject.QueryTable.Refresh _
BackgroundQuery:=False
End With
Dim FilePath As String
With .Worksheets("Fname")
.Visible = xlSheetVisible
FilePath = FolderPath & .Range("A7").Value & ".xlsx"
' Ensure that "Fname" is the active sheet
' when the new file is opened.
.Activate
End With
' Overwrite without confirmation.
Application.DisplayAlerts = False
.SaveAs FilePath
Application.DisplayAlerts = True
.Close
End With
Success = True
SafeExit:
.Quit
End With
On Error GoTo 0

If Success Then
MsgBox "Workbook created.", vbInformation, "Success"
Else
MsgBox "Workbook not created.", vbCritical, "Failure"
End If

Exit Sub
NewAppError:
MsgBox "Run-time error '" & Err.Number & "':" & vbLf & Err.Description
Resume SafeExit
End Sub