• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VB Code open current workbook after saving file

Ateeb Ali

Member
Dear, I am using following code to save file and return on original file but I need to define file path manually, is there way that VB code detect the file location itself;

Code:
Dim Path As String
Dim fileName As String
 If Dir(ThisWorkbook.Path & "\Backup", vbDirectory) = vbNullString Then MkDir ThisWorkbook.Path & "\Backup"
Path = ThisWorkbook.Path & "\Backup" & "\"

fileName = Range("O6")
ActiveWorkbook.SaveAs fileName:=Path & fileName & ".xlsb", FileFormat:=50
Application.DisplayAlerts = False


ChDir "C:\Users\ltpurc08\Desktop\Thread Consumption Software"
Workbooks.Open fileName:= _
"C:\Users\ltpurc08\Desktop\Thread Consumption Software\Thread Consumption.xlsb"
Windows("Thread Consumption.xlsb").Activate
ActiveWindow.ActivateNext

ActiveWorkbook.Close

   

   
End Sub
 
Why not use ActiveWorkbook.SaveCopyAs in place of ActiveWorkbook.SaveAs.

This way you will save a copy of file but will remain on active workbook and carry on with whatever you want to do with it.

Thanks/Ajesh
 
Sir, I changed but its not working
It gives error as;
Compile Error
Named argument not found, when click ok
it highlight this;
FileFormat:=
 
Last edited:
SaveCopyAs method does not take file format parameter. Try without it.

ActiveWorkbook.SaveCopyAs fileName:=Path & fileName & ".xlsb"
 
OH.... its worked but It really do all changes in original file which I dont wanted to, I want to save copy with changes and then return to original file without change, see below my complete code;
Code:
Sub filename_cellvalue()

ActiveWorkbook.Save

For sh = 1 To Sheets.Count
Sheets(sh).Visible = -1
Next sh


Application.DisplayAlerts = False
    Sheets(Array("Consolidated Report", "Welcome")).Select
    Sheets("Consolidated Report").Activate
    ActiveWindow.SelectedSheets.Delete
      Application.DisplayAlerts = True
   
    Sheets("New Style").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete


Sheets("Garment Detail").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete


Sheets("Picture").Select
      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
   
    Sheets("Operations").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete

   
    Sheets("Machines Data").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete

   
    Sheets("Layout").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete

     
    Sheets("Report").Select
      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
       
    Sheets("Summary").Select
      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
       
    ActiveSheet.Shapes.Range(Array("Button 554")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 556")).Select
    Selection.Delete
        ActiveSheet.Shapes.Range(Array("Button 553")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 627")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 555")).Select
    Selection.Delete

Sheets("Short").Select
ActiveWindow.SelectedSheets.Visible = False

Dim Path As String
Dim FileName As String
Application.DisplayAlerts = False

 If Dir(ThisWorkbook.Path & "\Backup", vbDirectory) = vbNullString Then MkDir ThisWorkbook.Path & "\Backup"
Path = ThisWorkbook.Path & "\Backup" & "\"

FileName = Range("O6")
ActiveWorkbook.SaveAs fileName:=Path & fileName & ".xlsb", FileFormat:=50
Application.DisplayAlerts = False


ChDir "C:\Users\ltpurc08\Desktop\Thread Consumption Software"
Workbooks.Open fileName:= _
"C:\Users\ltpurc08\Desktop\Thread Consumption Software\Thread Consumption.xlsb"
Windows("Thread Consumption.xlsb").Activate
ActiveWindow.ActivateNext

ActiveWorkbook.Close

   



   
End Sub
 
Finally this code worked;
Code:
Dim Path As String
Dim FileName As String
Application.DisplayAlerts = False

 If Dir(ThisWorkbook.Path & "\Backup", vbDirectory) = vbNullString Then MkDir ThisWorkbook.Path & "\Backup"
Path = ThisWorkbook.Path & "\Backup" & "\"

FileName = Range("O6")
ActiveWorkbook.SaveCopyAs FileName:=Path & FileName & ".xlsb"
Application.DisplayAlerts = False
Application.Workbooks.Open (ThisWorkbook.FullName)
   
End Sub
 
OH.... its worked but It really do all changes in original file which I dont wanted to, I want to save copy with changes and then return to original file without change, see below my complete code;
Code:
Sub filename_cellvalue()

ActiveWorkbook.Save

For sh = 1 To Sheets.Count
Sheets(sh).Visible = -1
Next sh


Application.DisplayAlerts = False
    Sheets(Array("Consolidated Report", "Welcome")).Select
    Sheets("Consolidated Report").Activate
    ActiveWindow.SelectedSheets.Delete
      Application.DisplayAlerts = True
  
    Sheets("New Style").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete


Sheets("Garment Detail").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete


Sheets("Picture").Select
      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
  
    Sheets("Operations").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete

  
    Sheets("Machines Data").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete

  
    Sheets("Layout").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete

    
    Sheets("Report").Select
      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
      
    Sheets("Summary").Select
      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
      
    ActiveSheet.Shapes.Range(Array("Button 554")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 556")).Select
    Selection.Delete
        ActiveSheet.Shapes.Range(Array("Button 553")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 627")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 555")).Select
    Selection.Delete

Sheets("Short").Select
ActiveWindow.SelectedSheets.Visible = False

Dim Path As String
Dim FileName As String
Application.DisplayAlerts = False

If Dir(ThisWorkbook.Path & "\Backup", vbDirectory) = vbNullString Then MkDir ThisWorkbook.Path & "\Backup"
Path = ThisWorkbook.Path & "\Backup" & "\"

FileName = Range("O6")
ActiveWorkbook.SaveAs fileName:=Path & fileName & ".xlsb", FileFormat:=50
Application.DisplayAlerts = False


ChDir "C:\Users\ltpurc08\Desktop\Thread Consumption Software"
Workbooks.Open fileName:= _
"C:\Users\ltpurc08\Desktop\Thread Consumption Software\Thread Consumption.xlsb"
Windows("Thread Consumption.xlsb").Activate
ActiveWindow.ActivateNext

ActiveWorkbook.Close

  



  
End Sub
Ideally in that case, you should first save a copy and then make changes to the new workbook. What you are doing is making change to old workbook and then saving a copy.
 
This should help you:
Code:
Sub filename_cellvalue()
Dim SourceWB As Workbook
Dim NewWB As Workbook

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

Set SourceWB = ActiveWorkbook

With SourceWB
    .Save
    .SaveCopyAs (.Path + "\" & "Test.xlsx")
End With

Workbooks.Open (SourceWB.Path + "\" & "Test.xlsx")

Set NewWB = ActiveWorkbook

With NewWB


'your code here to modify new workbook


End With

NewWB.Close SaveChanges:=True

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With


End Sub

Thanks/Ajesh
 
One more thing, you should be very careful while using Application level properties as they apply to Excel as a whole and not to specific workbook(s). For e.g. when you set Application.DisplayAlert = False at starting of your procedure, it should be reset to True at the end else you will not get any application level alerts till Excel is open or the property is reset to True.
 
Dear Sir, I do it because if file already exist, it give error message, can you amen the code to save file with extension if file already exist so user will not prompted error message since worksheet and vb project is locked
 
I
Dear Sir, I do it because if file already exist, it give error message, can you amen the code to save file with extension if file already exist so user will not prompted error message since worksheet and vb project is locked
have already provided you that in code above.
I was referring to this part:

Code:
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
EndWith
which need to be set to true at the end.
Code:
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
EndWith
 
Sir, the code not working;

Code:
Workbooks.Open (SourceWB.Path + "\" & "Test.xlsx")

Also I need to save file with cell range as Sheet Summary, Range O6

The file version will be Excel Binary format
 
Please see this condition,
Code:
If Dir(ThisWorkbook.Path & "\Backup", vbDirectory) = vbNullString Then MkDir ThisWorkbook.Path & "\Backup"
Path = ThisWorkbook.Path & "\Backup" & "\"

FileName = Range("O6")
ActiveWorkbook.SaveCopyAs FileName:=Path & FileName & ".xlsb"
it also need to add a directory called "backup"
 
I can't test your full code without a sample file but it should be something like this:

Code:
Sub filename_cellvalue()

Dim SourceWB As Workbook
Dim NewWB As Workbook
Dim strPath As String
Dim FileName As String

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

Set SourceWB = ActiveWorkbook

With SourceWB
    .Save
    FileName = .Sheets("Short").Range("O6").Value
    If Dir(.Path & "\Backup", vbDirectory) = vbNullString Then MkDir .Path & "\Backup"
    strPath = .Path & "\Backup\"
    .SaveCopyAs (strPath & FileName & ".xlsb")
End With

Workbooks.Open (strPath & FileName & ".xlsb")

Set NewWB = ActiveWorkbook

With NewWB

    For sh = 1 To Sheets.Count
    Sheets(sh).Visible = -1
    Next sh


Application.DisplayAlerts = False
    Sheets(Array("Consolidated Report", "Welcome")).Select
    Sheets("Consolidated Report").Activate
    ActiveWindow.SelectedSheets.Delete
      Application.DisplayAlerts = True
  
    Sheets("New Style").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete


Sheets("Garment Detail").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete


Sheets("Picture").Select
      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
  
    Sheets("Operations").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete

  
    Sheets("Machines Data").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete

  
    Sheets("Layout").Select

      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete

    
    Sheets("Report").Select
      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
      
    Sheets("Summary").Select
      ActiveSheet.Shapes.Range(Array("ColorA3")).Select
    Selection.Delete
      
    ActiveSheet.Shapes.Range(Array("Button 554")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 556")).Select
    Selection.Delete
        ActiveSheet.Shapes.Range(Array("Button 553")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 627")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 555")).Select
    Selection.Delete

Sheets("Short").Select
ActiveWindow.SelectedSheets.Visible = False

End With

NewWB.Close SaveChanges:=True

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

'Dim Path As String
'Dim FileName As String
'Application.DisplayAlerts = False
'
' If Dir(ThisWorkbook.Path & "\Backup", vbDirectory) = vbNullString Then MkDir ThisWorkbook.Path & "\Backup"
'Path = ThisWorkbook.Path & "\Backup" & "\"
'
'FileName = Range("O6")
'ActiveWorkbook.SaveAs FileName:=Path & FileName & ".xlsb", FileFormat:=50
'Application.DisplayAlerts = False
'
'
'ChDir "C:\Users\ltpurc08\Desktop\Thread Consumption Software"
'Workbooks.Open FileName:= _
'"C:\Users\ltpurc08\Desktop\Thread Consumption Software\Thread Consumption.xlsb"
'Windows("Thread Consumption.xlsb").Activate
'ActiveWindow.ActivateNext
'
'ActiveWorkbook.Close
  
End Sub
 
Change this line
FileName = .Sheets("Short").Range("O6").Value
to
FileName = .Sheets("Summary").Range("O6").Value

and it should work. Working for me.
 
Dear Sir, I am sorry to open this post again.
I also wanted to add following code in the "save as" file and not to the original file.

Code:
Public Sub Workbook_Open()
  Dim Rng As Range
  Set Rng = ThisWorkbook.Sheets("Summary").Range("C56")
    With Rng
        .Value = .Value + 1
    End With
  
End Sub
 
Last edited by a moderator:
Back
Top