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
Related
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
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 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
I would like to convert delimited txt into xls file. I have come up with 2 very simple line of commands which I suppose should work but in reality it didn't. Can anyone tell me what mistakes I have made?
If this work, I am going to loop it with dir for 3000 txt files...
Thanks!
Bosco
Sub ConvertDelimitedTXTtoXLS()
Dim wb As Workbooks
wb.OpenText Filename:="C:\Users\boscotsin\Desktop\test0.txt", DataType:=xlDelimited, Tab:=True
wb.SaveAs Filename:="C:\Users\boscotsin\Desktop\success.xls"
End Sub
Sub delimitedTXTtoXLS()
Dim wb As Workbook
Workbooks.OpenText filename:="C:\Users\boscotsin\Desktop\test0.txt", origin:=xlMSDOS, DataType:=xlDelimited, Tab:=True
Set wb = ActiveWorkbook
wb.SaveAs filename:="C:\Users\boscotsin\Desktop\success.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
wb.Close SaveChanges:=True
End Sub
' Excel8
Sub delimitedTXTtoXLS2()
Dim wb As Workbook
Workbooks.OpenText FileName:="C:\Users\boscotsin\Desktop\test0.txt", origin:=xlMSDOS, DataType:=xlDelimited ', Comma:=True
Set wb = ActiveWorkbook
wb.SaveAs FileName:="C:\Users\boscotsin\Desktop\success.xlsx", FileFormat:=56, CreateBackup:=False
wb.Close SaveChanges:=True
End Sub
I'm using the code below so users can "export" the Workbook they're working on. Basically, they're working in a Read-only master workbook, when they click the sub below it executes a SaveAs to a folder the user selects with the file name of whatever is in: Sheets("Master").Range("B5")
This works fine, the only problem is that if there's a '.xlsm' file in the folder the user selects and they click it to grab the filename, the saved Workbook name becomes "XXXXXX.xlsm.xlsm". If the user doesn't click anything and hits save it works fine.
Any ideas? Let me know if this wasn't clear
Sub ExportTrip()
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFile As String
Application.ScreenUpdating = False ' Prevents screen refreshing.
CurrentFile = ThisWorkbook.FullName
NewFile = Application.GetSaveAsFilename( _
InitialFileName:=Sheets("Master").Range("B5"))
If NewFile <> "" And NewFile <> "False" Then
ActiveWorkbook.SaveAs filename:=NewFile & "xlsm", _
FileFormat:=52, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
Application.DisplayAlerts = False
ActBook.Close
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
End Sub
Figured it out, needed to add file filter. See below:
Sub ExportTrip()
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFile As String
Application.ScreenUpdating = False ' Prevents screen refreshing.
CurrentFile = ThisWorkbook.FullName ' saves filename of current workbook
NewFile = Application.GetSaveAsFilename( _
InitialFileName:=Sheets("Master").Range("B5"), _
FileFilter:="ARMS Export *.xlsm (*.xlsm),") ' gets filename for exported workbook
If NewFile <> "" And NewFile <> "False" Then 'if user doesn't pick name
ActiveWorkbook.SaveAs filename:=NewFile, _
FileFormat:=52, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Set ActBook = ActiveWorkbook 'declares variable for open workbook
Workbooks.Open CurrentFile 'reopens original workbook
Application.DisplayAlerts = False
ActBook.Close 'closes exported workbook
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
End Sub