如何写VBA脚本来保存和replace文件没有错误

我读了这些线程如何保存和replace文件没有得到提示。 但是，我意识到他们有一个错误（EXECEL.EXE * 32没有在任务pipe理器中结束）。 即使有更多的提示和文件保存成功…它不能在同一个子内重新打开。 当它被重新打开时，在任务pipe理器列表中创build另一个Excel会话，因此从该文件检索数据时出错。

Private Sub Import_Click() Dim ExcelAppcn As Object Set ExcelAppcn = CreateObject("Excel.Application") With ExcelAppcn .Workbooks.Open (Me.txtCSVFIle.Value) .DisplayAlerts = False .ActiveWorkbook.SaveAs FileName:=Left(Me.txtCSVFIle.Value, InStrRev(Me.txtCSVFIle.Value, ".") - 1), FileFormat:=51 Dim chgfilename As String chgfilename = Left(Me.txtCSVFIle.Value, InStrRev(Me.txtCSVFIle.Value, ".") - 1) + ".xlsx" .Visible = False .ActiveWorkbook.close False .Quit End With Set ExcelAppcn = Nothing 'at the end of this line the excel.exe *32 is ended in task manager Dim ExcelApp As Object Set ExcelApp = CreateObject("Excel.Application") ExcelApp.Workbooks.Open (chgfilename) ExcelApp.DisplayAlerts = False Dim s As String, ary With Range("A2") s = .Text ary = Split(s, "-") .Value = DateSerial(ary(2), ary(1), ary(0)) .NumberFormat = "m/d/yyy" End With ExcelApp.ActiveWorkbook.SaveAs FileName:=Left(Me.txtCSVFIle.Value,InStrRev(Me.txtCSVFIle.Value, ".") - 1), FileFormat:=51,ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges ExcelApp.DisplayAlerts = True ExcelApp.Visible = False ExcelApp.ActiveWorkbook.close False ExcelApp.Quit Set ExcelApp = Nothing ' doesn't work, task manager still have the EXCEL.EXE *32 

该

 ExcelApp.DisplayAlerts = False 

只是没有让你看到提示和保存成功。 但它导致EXCEL.EXE * 32仍然在任务pipe理器中运行。 因此当你打开其他excel文件时，这个文件会再次popup。 或另一种情况下，你不能删除该文件，除非你在任务pipe理器中完成任务。

Answer 1

我没有看到你的代码有什么问题，但仍然，为什么你使用两个不同的Excel对象，当你可以达到你想要的第一个对象？

另外，如果您使用“延迟绑定”，则使用“更改”

Excel.XlSaveConflictResolution.xlLocalSessionChanges为2

试试这个（UNTESTED）

在运行这个检查之前，在任务pipe理器中没有Excel实例。 这是为了确保我们可以对这个代码进行公平的testing。

 Private Sub Import_Click() Dim ExcelAppcn As Object Dim chgfilename As String Dim s As String, ary Set ExcelAppcn = CreateObject("Excel.Application") With ExcelAppcn .DisplayAlerts = False .Visible = False .Workbooks.Open (Me.txtCSVFIle.Value) .ActiveWorkbook.SaveAs Filename:=Left(Me.txtCSVFIle.Value, _ InStrRev(Me.txtCSVFIle.Value, ".") - 1), FileFormat:=51 chgfilename = Left(Me.txtCSVFIle.Value, InStrRev(Me.txtCSVFIle.Value, ".") - 1) & _ ".xlsx" .ActiveWorkbook.Close False .Workbooks.Open (chgfilename) With Range("A2") s = .Text ary = Split(s, "-") .Value = DateSerial(ary(2), ary(1), ary(0)) .NumberFormat = "m/d/yyy" End With .ActiveWorkbook.SaveAs Filename:=Left(Me.txtCSVFIle.Value, _ InStrRev(Me.txtCSVFIle.Value, ".") - 1), _ FileFormat:=51, ConflictResolution:= 2 .ActiveWorkbook.Close False .DisplayAlerts = True .Quit End With Set ExcelAppcn = Nothing End Sub 

甚至更好的方法是定义工作簿和工作表对象，然后使用它们。例如（未testing）

 Private Sub Import_Click() Dim oXLApp As Object, oXLWb As Object, oXLWs As Object Dim chgfilename As String Dim s As String, ary Set oXLApp = CreateObject("Excel.Application") With oXLApp .DisplayAlerts = False .Visible = False Set oXLWb = .Workbooks.Open(Me.txtCSVFIle.Value) oXLWb.SaveAs Filename:=Left(Me.txtCSVFIle.Value, _ InStrRev(Me.txtCSVFIle.Value, ".") - 1), FileFormat:=51 chgfilename = Left(Me.txtCSVFIle.Value, _ InStrRev(Me.txtCSVFIle.Value, ".") - 1) & ".xlsx" oXLWb.Close False Set oXLWb = .Workbooks.Open(chgfilename) '~~> Change name of sheet as applicable Set oXLWs = oXLWb.Sheets("Sheet1") With oXLWs.Range("A2") s = .Text ary = Split(s, "-") .Value = DateSerial(ary(2), ary(1), ary(0)) .NumberFormat = "m/d/yyy" End With oXLWb.SaveAs Filename:=Left(Me.txtCSVFIle.Value, _ InStrRev(Me.txtCSVFIle.Value, ".") - 1), _ FileFormat:=51, ConflictResolution:= 2 oXLWb.Close False Set oXLWs = Nothing Set oXLWb = Nothing .DisplayAlerts = True .Quit End With Set oXLApp = Nothing End Sub 

Answer 2

尝试使用On Error像这样：

 Dim ExcelApp As Object Set ExcelApp = CreateObject("Excel.Application") On Error GoTo MyLabel: ExcelApp.Workbooks.Open (chgfilename) ExcelApp.DisplayAlerts = False Dim s As String, ary With Range("A2") s = .Text ary = Split(s, "-") .Value = DateSerial(ary(2), ary(1), ary(0)) .NumberFormat = "m/d/yyy" End With ExcelApp.ActiveWorkbook.SaveAs FileName:=Left(Me.txtCSVFIle.Value,InStrRev(Me.txtCSVFIle.Value, ".") - 1), FileFormat:=51,ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges ExcelApp.DisplayAlerts = True ExcelApp.Visible = False ExcelApp.ActiveWorkbook.close False MyLabel: ExcelApp.Quit Set ExcelApp = Nothing ' doesn't work, task manager still have the EXCEL.EXE *