CODEWITHSUNDEEP
vbaexcel
Leon
Leon

Reputation: 11

how to write vba script to saveas and replace file without error

I read those thread on how to saveas and replace file without getting prompt. However, i realised there is a bug to them(the EXECEL.EXE *32 wasn't ended in the task manager). Even though there was any more prompt and the file is saved successfully... it can't be reopen inside the same sub. When it was reopened, another excel session was created in the Task Manager list, thus there is error retrieving data from this file.

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

the 

ExcelApp.DisplayAlerts = False

only didn't let u see the prompt and saved successfully. but it resulted EXCEL.EXE *32 to still run in task manager. thus when u opened other excel file, this file will pop up again. or another case, u can't delete the file unless u end task it in task manager.

Upvotes: 1

Views: 2254

Answers (2)

Siddharth Rout
Siddharth Rout

Reputation: 149295

I don't see anything wrong with your code but still, why are you using two different excel object when you can achieve what you want with the first object?

Also if you are using Late Binding then Change

Excel.XlSaveConflictResolution.xlLocalSessionChanges to 2

Try this (UNTESTED)

Before you run this check of there is no Excel instance in the task manager. This is to ensure that we can do fair test on this code.

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

Even a much better way would be that you define your workbook and worksheet objects and then work with them :) For example (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

Upvotes: 1

user1429899
user1429899

Reputation: 288

Try using On Error somehow like this:

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 *

Upvotes: 0

Related Questions