如何编写vba脚本来saveas并替换文件而不会出错

时间:2014-08-19 08:22:32

标签: excel vba excel-vba

我阅读了关于如何保存和替换文件而没有得到提示的那些线程。但是,我意识到它们有一个错误(EXECEL.EXE * 32并未在任务管理器中结束)。即使有任何更多提示并且文件已成功保存...它也无法在同一个子网站内重新打开。重新打开时,在“任务管理器”列表中创建了另一个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仍在任务管理器中运行。因此当你打开其他excel文件时,这个文件会再次弹出。或者另一种情况,你不能删除文件,除非你在任务管理器中结束任务。

2 个答案:

答案 0 :(得分:1)

我没有看到你的代码有什么问题但是,为什么你在使用第一个对象实现你想要的东西时使用两个不同的excel对象?

此外,如果您使用的是Late Binding,则更改

Excel.XlSaveConflictResolution.xlLocalSessionChanges2

试试这个(UNTESTED)

在运行此检查之前,任务管理器中没有Excel实例。这是为了确保我们可以对此代码进行公平测试。

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

更好的方法是定义工作簿和工作表对象,然后使用它们:)例如(UNTESTED)

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

答案 1 :(得分:0)

尝试以某种方式使用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 *