vba excel在移动Excel表格时保持打开状态

Question

我有这段代码。我基本上是在一张纸上生成一个列表并将其重命名为RSSR列表。然后我拿起那张纸并将它移到一张现有的纸上。会发生什么情况是代码的最后几行不会保存工作簿，我会将所有格式化并且excel不会关闭。我将表格移到了保存的工作簿以及该excel的实例已关闭。当我在excel上结束任务并重新运行代码时，它说实例不再存在类似于服务器或机器的东西不再存在。我无法得到我移动的excel表来保存并关闭excel的实例。如果它杀死excel它会在下次运行该过程时出错。我想在此过程中关闭excel。这里是我的代码：

Public Function *sFormat*s() 
Dim xlApp As Excel.Application 
Dim xlApp2 As Excel.Application 
Dim wb As Excel.Workbook 
Dim ws As Excel.Worksheet 
Dim wb2 As Excel.Workbook 
Dim ws2 As Excel.Worksheet 
Dim MyFileName As String 
Dim afile As String 
Dim bfile As String 

afile = "S:\*s\Tyco-*s Receiving Tracking MASTER V 1.4 2017-05-06.xlsx" 
bfile = "S:\_Reports\*s\Tyco-*s Receiving Tracking MASTER - " 

MyFileName = bfile & Format(Date, "mm-dd-yyyy") & ".xls" 
MyFileName2 = afile 

On Error Resume Next 
Set xlApp = CreateObject("Excel.Application") 
On Error GoTo 0 

Set wb2 = xlApp2.Workbooks.Open(MyFileName2) 
Set ws2 = wb2.Sheets(1) 
ws2.Activate 

xlApp.DisplayAlerts = False 
wb2.Sheets("RSSR_List").Delete 
xlApp.DisplayAlerts = True 

wb2.CheckCompatibility = False 
wb2.Save 
wb2.CheckCompatibility = True 
wb2.Close SaveChanges:=False 

xlApp.Quit 

Set xlApp = Nothing 
Set wb2 = Nothing 
Set ws2 = Nothing 

On Error Resume Next 
Set xlApp = CreateObject("Excel.Application") 
On Error GoTo 0 

Set wb = xlApp.Workbooks.Open(MyFileName) 
Set ws = wb.Sheets(1) 
ws.Activate 

wb.Sheets(1).Name = "RSSR_List" 

Set ws = wb.Sheets(1) 
ws.Activate 

wb.ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$F$312"), , xlYes).Name = _ 
    "RSSR" 

ws.Range("A1:F312").Select 

ws.Cells.Rows("2:2").Select 
xlApp.ActiveWindow.FreezePanes = False 
xlApp.ActiveWindow.FreezePanes = True 

ws.Columns("A:Z").HorizontalAlignment = xlCenter 
ws.Rows("1:1").Font.Bold = True 
ws.Rows("1:1").Font.ColorIndex = 1 
ws.Rows("1:1").Interior.ColorIndex = 15 
ws.Cells.Font.Name = "Calbri" 
ws.Cells.Font.Size = 8 
ws.Cells.EntireColumn.AutoFit 
ws.Cells.EntireRow.AutoFit 

xlApp.Cells.Borders.LineStyle = xlContinuous 
xlApp.Cells.Borders.Weight = xlThin 
xlApp.Cells.Borders.ColorIndex = 0 

ws.Cells.Rows("1:1").Select 

wb.CheckCompatibility = False 
wb.Save 
wb.CheckCompatibility = True 
wb.Close SaveChanges:=False 

Set wb2 = xlApp.Workbooks.Open(MyFileName2) 

MsgBox "Before Move" 
ws.Move Before:=Workbooks("Tyco-*s Receiving Tracking MASTER V 1.4 2017-05-06.xlsx").Sheets(1) 
MsgBox "AFter Move" 

wb2.CheckCompatibility = False 
wb2.Save 
wb2.CheckCompatibility = True 
wb2.Close SaveChanges:=True 

Set wb = xlApp.Workbooks.Open(MyFileName) 

wb.CheckCompatibility = False 
wb.Save 
wb.CheckCompatibility = True 
wb.Close SaveChanges:=True 

xlApp.Quit 

Set xlApp = Nothing 
Set wb = Nothing 
Set ws = Nothing 
Set wb2 = Nothing 
Set ws2 = Nothing 


End Function 

Answer 1

有时这些各种各样的问题，可以通过将一个DoEvents呼叫违规操作后得到解决。因此，在这种情况下，你有这样的：

MsgBox "Before Move" 
ws.Move Before:=Workbooks("Tyco-*s Receiving Tracking MASTER V 1.4 2017-05-06.xlsx").Sheets(1) 
DoEvents 
MsgBox "AFter Move" 

这往往为Excel 2016年

Answer 2

ws.Move Before:=xlApp.Workbooks("Tyco-*s Receiving Tracking Master V 1.4...)Sheets(1) 
DoEvents 

这个工作是必要的。