I wrote code that saves the book in a specific format. After saving, the book is only available in read-only mode. What could be the error?
Sub SaveAs()
Application.DisplayAlerts = False
Dim relativePath As String
relativePath = ThisWorkbook.Path & "\" & ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=relativePath, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, ReadOnlyRecommended:=False, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
Application.DisplayAlerts = True
End Sub
Related
I am not the best at VBA and a third-party programme has suddenly stopped working strangely. I am attempting to save as csv and save as 97-2003 excel file.
This was previously working but now I am receiving a Error 1004 message. Can anybody please help me?
Application.DisplayAlerts = False
xls = ActiveWorkbook.FullName
Length = Len(xls) - 3
CSV = Left(xls, Length) & "csv"
dlist = Left(xls, Length - 1)
ActiveWorkbook.SaveAs Filename:= _
CSV, FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWorkbook.SaveAs Filename:= _
xls, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
Application.DisplayAlerts = True
ActiveSheet.Name = "TITLEBLOCK_DRAWING LIST"
ActiveCell.Select
MsgBox "CSV and XLS files saved"
Hope this helps...
Sub SaveTwoFileTypes()
Dim xlsFileName As String
Dim lengthXlsFileName As Integer
Dim csvFileName As String
Dim dlist As String
Application.DisplayAlerts = False
'Get workbook name (e.g. "https://d.docs.live.net/somealpanumericstring/Documents/Book2.xls")
xlsFileName = ActiveWorkbook.FullName
'Get length of name (e.g. 60), then subtract 4 for the period and 3-digit extension
lengthXlsFileName = Len(xlsFileName) - 4
'Tack on the .csv extension after "https://d.docs.live.net/somealpanumericstring/Documents/Book2"
csvFileName = Left(xlsFileName, lengthXlsFileName) & ".csv"
'No idea why this is here...
dlist = Left(xlsFileName, lengthXlsFileName - 1)
'Save both formats
ActiveWorkbook.SaveAs Filename:= _
csvFileName, FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWorkbook.SaveAs Filename:= _
xlsFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
Application.DisplayAlerts = True
'Name the active worksheet
ActiveSheet.Name = "TITLEBLOCK_DRAWING LIST"
ActiveCell.Select
'Display a message box with this text
MsgBox "CSV and XLS files saved"
End Sub
My goal is to open multiple excel files from input folder and convert them to .csv in output folder. I am facing minor issues where
code converts .xlsx to .csv , converts .xls to .csv but in output
folder, it stores .csv and .xls files. I can't figure out why .xls
files are also getting stored. I only wish to store .csv files
I only want to convert data from excel 'Sheet1' but the code is
converting data from an active sheet. How to specify to convert
data only from 'Sheet1'?
Option Explicit
Sub ImportMultipleCsvFile()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Dim InputCsvFile As Variant
Dim InputFolder As String, OutputFolder As String
InputFolder = "C:\Users\excel_format"
OutputFolder = "C:\Users\csv_format"
InputCsvFile = Dir(InputFolder & "\*.xl??")
While InputCsvFile <> ""
Workbooks.OpenText Filename:=InputFolder & "\" & InputCsvFile, DataType:=xlDelimited, Comma:=True
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
InputCsvFile = Dir
Wend
Application.Calculation = xlCalculationAutomatic
End Sub
If you change this:
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
to that:
--- to remove VBA codeblocks from Workbook before saving them as .csv, I have used this stackoverflow answer, then I checked it to make sense by using the info from here ---
Dim StartWb As Workbook
Dim TempWb As Workbook
Set StartWb = ActiveWorkbook
Set TempWb = Application.Workbooks.Add
StartWb.Worksheets("Sheet1").Copy Before:=TempWb.Worksheets(1)
If TempWb.Worksheets.Count > 1 Then
Do While (TempWb.Worksheets.Count > 1)
TempWb.Worksheets(TempWb.Worksheets.Count).Delete
Loop
End If
' ----- This is new to delete the codeblocks from your Sheets -----------
Dim Element As Object
For Each Element In TempWb.VBProject.VBComponents
'For Each Item In Element.Collection ' This For loop wasn't needed at the and but I forgot it in
Element.CodeModule.DeleteLines 1, Element.CodeModule.CountOfLines
'Next ' It has most likely thrown up Undeclared Variable error with Option Eplicit
Next
' -----------------------------------------------------------------------
If InStr(StartWb.Name, ".xlsx") Then
TempWb.SaveAs Filename:=OutputFolder & "\" & Replace(StartWb.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ElseIf InStr(StartWb.Name, ".xls") Then
TempWb.SaveAs Filename:=OutputFolder & "\" & Replace(StartWb.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
End If
TempWb.Close (xlNo)
then you will only get your .csv file saved, as well as it will only contain that first sheet.
I would also put these:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
at the end of your code before or after:
Application.Calculation = xlCalculationAutomatic
Also swap this:
ActiveWorkbook.Close
to that:
StartWb.Close (xlNo)
To remove code from workbooks by code you have to change settings in Excel:
I want to save the active workbook as xlsx and then close it without closing all the open excel workbooks. This code works but closes all the open excel files.
If I remove Application.Quit and leave ThisWorkbook.Close it will work only if I have more then one workbook open but if I only have the one workbook open it will close but leave a blank excel window open.
Sub SaveAsXlsx()
Dim varResponse As Variant
varResponse = MsgBox("Save As xlsx Removing Macros & Then Closes The Workbook", vbYesNo, "Save As xlsx")
If varResponse <> vbYes Then Exit Sub
Application.DisplayAlerts = False
Dim FilePath As String
FilePath = ThisWorkbook.FullName
FilePath = Left(FilePath, Len(FilePath) - 5) & " To Review" & ".xlsx"
ThisWorkbook.SaveAs Filename:=FilePath, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
'Enter Anything to Happen on xlsx Book Here
Range("A1").Select
ThisWorkbook.Save
FilePath = Application.ActiveWorkbook.FullName
MsgBox "Saved Review Copy As" & Chr(10) & Chr(10) & FilePath, , "Saved!"
Application.Quit
ThisWorkbook.Close
End Sub
In order to close Excel if your code is closing the last open workbook, but leave it open if there are other workbooks open, you'll need to check the Application.Workbook.Count property, like this:
Sub SaveAsXlsx()
Dim varResponse As Variant
varResponse = MsgBox("Save As xlsx Removing Macros & Then Closes The Workbook", vbYesNo, "Save As xlsx")
If varResponse <> vbYes Then Exit Sub
Application.DisplayAlerts = False
Dim FilePath As String
FilePath = ThisWorkbook.FullName
FilePath = Left(FilePath, Len(FilePath) - 5) & " To Review" & ".xlsx"
ThisWorkbook.SaveAs Filename:=FilePath, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
'Enter Anything to Happen on xlsx Book Here
Range("A1").Select
ThisWorkbook.Save
FilePath = Application.ActiveWorkbook.FullName
MsgBox "Saved Review Copy As" & Chr(10) & Chr(10) & FilePath, , "Saved!"
ThisWorkbook.Close
If Excel.Application.Workbooks.Count = 0 Then
Application.Quit
End If
End Sub
I have a macro code like
Do Until MyFileName = ""
Workbooks.Open Filename:=MyPath & MyFileName
ActiveWorkbook.SaveAs Filename:=Left(MyFileName, InStr(1, MyFileName, ".xls") - 1), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbooks.CloseSaveChanges:=TRUE
MyFileName = Dir
Loop
Its working fine but while converting to csv the file is opening. I want to close the file and save changes is true. Please help me.
save the new name in a variable and use Workbook("name").close(true)
Dim wbName As String
Do Until MyFileName = ""
Workbooks.Open Filename:=MyPath & MyFileName
wbName = Left(MyFileName, InStr(1, MyFileName, ".xls") - 1)
ActiveWorkbook.SaveAs Filename:=wbName, FileFormat:=xlCSV, CreateBackup:=False
Workbooks(wbName).Close (True)
ActiveWorkbooks.Close SaveChanges:=True
MyFileName = Dir
Loop
End Sub
When I use the following code to:
save a macro-enabled workbook
in the same folder as the open workbook
it does save the file with the wrong name and on the desktop:
Sub Save_New_MacroEnabledFile()
Dim thisWb As Workbook
Set thisWb = ActiveWorkbook
Worksheets("Sheet_with_VBA_Button").Activate
ActiveWorkbook.SaveAs Filename:=thisWb.Path & Sheets("Sheet_with_NewFile's_Name").Range("A2"), FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, Password:=vbNullString, WriteResPassword:=vbNullString, _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
What am I doing wrong?
You didn't add slash when you creating new filepath.
Probably the folder where you have this file is on the desktop and without slash it just append the name of the file to the name of the folder, i.e.
folder was:
C:\Users\Antoine\Desktop\Folder
and after appending the filename without slash it was like:
C:\Users\Antoine\Desktop\Folderfilename.xlsx
Try this code:
Sub Save_New_MacroEnabledFile()
Dim thisWb As Workbook
Dim fileName As String
Set thisWb = ActiveWorkbook
Worksheets("Sheet_with_VBA_Button").Activate
Application.DisplayAlerts = False
fileName = thisWb.Path & "\" & Sheets("Sheet_with_NewFile's_Name").Range("A2") & VBA.IIf(Right(fileName, 5) = ".xlsm", "", ".xlsm")
ActiveWorkbook.SaveAs fileName:=fileName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:=vbNullString, WriteResPassword:=vbNullString, _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
End Sub