Need assistance to add command to save as .xlsm :-
Private Sub cmdSaveForm1_Click()
Dim strFolder As String
Dim i As Long
'Find the position of the period in the file name
i = InStr(ActiveWorkbook.Name, ".")
'Create a default file name by concatenating the file name without the extention _
plus the current date and time, and plus the xlsm extention
Filename = Left(ActiveWorkbook.Name, i - 1) & "_" & Format(Now, "yyyy-mm-dd_hh mm") & ".xlsm"
'Open Save As dialog to a default folder with default file name
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.InitialFileName = "P:\EU Funds Management - Treasury\TRS3_Abstract of Payments\TRS3_Authorisation_L1\" & Filename
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
.Execute
End With
End Sub
To save a Workbook as .xlsm you need the following file format
Excel 2007-2010 Macro-Enabled Workbook (.xlsm) - 52 - xlOpenXMLWorkbookMacroEnabled
To save a file to an chosen format you need to specify the appropriate format when saving. This can be done by adding FileFormat:= to your save action.
ThisWorkbook.SaveAs Filename:=Path & Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Below the addition of the save action and FileFormat to your code.
Private Sub cmdSaveForm1_Click()
Dim strFolder As String
Dim i As Long
'Find the position of the period in the file name
i = InStr(ActiveWorkbook.Name, ".")
'Create a default file name by concatenating the file name without the extention _
plus the current date and time, and plus the xlsm extention
Filename = Left(ActiveWorkbook.Name, i - 1) & "_" & Format(Now, "yyyy-mm-dd_hh mm") & ".xlsm"
'Open Save As dialog to a default folder with default file name
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.InitialFileName = "P:\EU Funds Management - Treasury\TRS3_Abstract of Payments\TRS3_Authorisation_L1\" & Filename
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
'get selected folder path from FileDialog, but remove filename from FileDialog
folderPath = Left(strFolder, InStrRev(strFolder, "\"))
'Save this workbook in chosen file path & appropriate filename
'File format .xlsm
ThisWorkbook.SaveAs Filename:=folderPath & Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End With
End Sub
Different Fileformats for excel are:
.xlsx = 51 '(52 for Mac)
.xlsm = 52 '(53 for Mac)
.xlsb = 50 '(51 for Mac)
.xls = 56 '(57 for Mac)
ActiveWorkbook.SaveAs FileFormat:=52 '=.xlsm in Windows
The solution is:
.FilterIndex = 2
1 = xlsx, 2 = xlsm
Private Sub cmdSaveForm1_Click()
Dim strFolder As String
Dim i As Long
'Find the position of the period in the file name
i = InStr(ActiveWorkbook.Name, ".")
'Create a default file name by concatenating the file name without the extention _
plus the current date and time, and plus the xlsm extention
Filename = Left(ActiveWorkbook.Name, i - 1) & "_" & Format(Now, "yyyy-mm-dd_hh mm") & ".xlsm"
'Open Save As dialog to a default folder with default file name
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.FilterIndex = 2 '2 = xlsm
.InitialFileName = "P:\EU Funds Management - Treasury\TRS3_Abstract of Payments\TRS3_Authorisation_L1\" & Filename
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
.Execute
End With
End Sub
Related
I am trying to loop through all the 'xlsx' files in a folder and convert them to 'xls' ( Excel 97-2003 Worksheet) format. I use the following codes but then the output files are still saved as 'xlsx' instead of 'xls'. I am a beginner and looking to learn more from others. Thanks for your help!
Sub Convert()
Dim strPath As String
Dim strFile As String
Dim strfilenew As String
Dim xWbk As Workbook
Dim xSFD, xRFD As FileDialog
Dim xSPath As String
Dim xRPath As String
Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)
With xSFD
.Title = "Please select the folder contains the xls files:"
.InitialFileName = "C:\"
End With
If xSFD.Show <> -1 Then Exit Sub
xSPath = xSFD.SelectedItems.Item(1)
Set xRFD = Application.FileDialog(msoFileDialogFolderPicker)
With xRFD
.Title = "Please select a folder for outputting the new files:"
.InitialFileName = "C:\"
End With
If xRFD.Show <> -1 Then Exit Sub
xRPath = xRFD.SelectedItems.Item(1) & "\"
strPath = xSPath & "\"
strFile = Dir(strPath & "*.xlsx")
strfilenew = Dir(strPath & "*.xls")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While strFile <> ""
If Right(strFile, 4) = "xlsx" Then
Set xWbk = Workbooks.Open(Filename:=strPath & strfilenew)
xWbk.SaveAs Filename:=xRPath & strfilenew, _
FileFormat:=xlExcel18
xWbk.Close SaveChanges:=True
End If
strFile = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
There was a bit of a mix-up in your file naming, basically as evidenced by the several double-declarations that I removed. The really big mistake was here, Set xWbk = Workbooks.Open(Filename:=strPath & strfilenew) where you tried to open the old workbook by the new name. I think the confusion started here "Please select the folder contains the xls files:". Of course, this is the folder with the XLSX files. The recommended antidote is to use "meaningful" variable names but you chose to speak in riddles (like xSFD) which makes coding more difficult.
However, the code below is largely yours, and it does work.
Sub Convert()
' 230
Dim Spath As String ' path to read from (XLSX files)
Dim Rpath As String ' path to write to (XLS files)
Dim strFile As String ' loop variable: current file name
Dim Wbk As Workbook ' loop object: current workbook(strFile)
Dim Sp() As String ' split array of strFile
Dim strFileNew As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select the folder contains the XLSX files:"
.InitialFileName = "C:\"
If .Show <> -1 Then Exit Sub
Spath = .SelectedItems.Item(1) & "\"
End With
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder for outputting the new files:"
.InitialFileName = "C:\"
If .Show <> -1 Then Exit Sub
Rpath = .SelectedItems.Item(1) & "\"
End With
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
strFile = Dir(Spath & "*.xlsx")
Do While strFile <> ""
If Right(strFile, 4) = "xlsx" Then
Sp = Split(strFile, ".")
Sp(UBound(Sp)) = "xls"
strFileNew = Join(Sp, ".")
Set Wbk = Workbooks.Open(Filename:=Spath & strFile)
Wbk.SaveAs Filename:=Rpath & strFileNew, FileFormat:=xlExcel8
Wbk.Close SaveChanges:=True
End If
strFile = Dir
Loop
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Observe that the new file name is created by splitting the old name on periods, changing the last element, and reassembling the modified array.
I tried this script to convert xlsx files to csv.
I want the old files to be in the folder and the name on csv file to be exact as xlsx file.
I am getting . extra on the csv extension like filename..csv.
Sub ConvertCSVToXlsx()
Dim myfile As String
Dim oldfname As String, newfname As String
Dim workfile
Dim folderName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
' Capture name of current file
myfile = ActiveWorkbook.Name
' Set folder name to work through
folderName = "C:\Test\"
' Loop through all CSV filres in folder
workfile = Dir(folderName & "*.xlsx")
Do While workfile <> ""
' Open CSV file
Workbooks.Open Filename:=folderName & workfile
' Capture name of old CSV file
oldfname = ActiveWorkbook.FullName
' Convert to XLSX
newfname = folderName & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".CSV"
ActiveWorkbook.SaveAs Filename:=newfname, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
' Delete old CSV file
Kill oldfname
Windows(myfile).Activate
workfile = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Pretty close.
Your comments are a bit confusing in the code.
If you are going to use left(len()-4 then you need to change the part to add csv without the period.
newfname = oldfname & "CSV"
Just a bit of an edit with the saveas line
You don't kill the original workbook, that deletes it from the folder.
The original workbook is no longer opened because you saved it as a new filename.
Sub ConvertCSVToXlsx()
Dim myfile As String
Dim oldfname As String, newfname As String
Dim workfile
Dim folderName As String
Dim wb As Workbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
' Capture name of current file
myfile = ActiveWorkbook.Name
' Set folder name to work through
folderName = "C:\New folder\"
' Loop through all CSV filres in folder
workfile = Dir(folderName & "*.xlsx")
Do While workfile <> ""
' Open CSV file
Workbooks.Open Filename:=folderName & workfile
Set wb = ActiveWorkbook
' Capture name of old CSV file
oldfname = Left(wb.FullName, Len(wb.FullName) - 4)
' Convert to XLSX
newfname = oldfname & "CSV"
wb.SaveAs Filename:=newfname, FileFormat:=xlCSV, CreateBackup:=False
wb.Close
workfile = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
So i have a VBA script that takes user input via userform then creates an output workbook to contain the data and saves it as a .csv. The issue im having is when i want to create the folder that the files will be saved into the directory is not the same for each workstation because my company uses Microsoft One Drive which changes the file path for the desktop. I have gotten this to work on my machine but every time i send my form to a user for testing they receive a runtime error and the application cannot create the folder on the desktop. on one occasion the folder was saved in "My Documents" when that is nowhere in my code. Hope you can help.
i have changed my code several times using if statements to verify the file path but i still see the same issue
User = Environ("Username") 'set the current users username to the User variable
WBpath = "C:\Users\" & User & "\OneDrive - CompanyName\Desktop" 'windows directory where the file will go
WBpath2 = "C:\Users\" & User & "\Desktop" 'windows directory where the file will go
WBName = "BulkUpload" & UserForm1.TextBox5.value & ".csv" 'the name of the file
WBFile = WBpath & "\BulkUploadFiles\" & WBName 'full file path we will be saving the file in
WBFile2 = WBpath2 & "\BulkUploadFiles\" & WBName 'full file path we will be saving the file in
For Each wb In Workbooks 'loop through each open excel workbook and perform the below action
If wb.Name = WBName Then 'perform the below action only if the currently selected workbook has the same name as the output workbook
Workbooks(WBName).Close 'close the selected excel workbook
End If 'done checking if the file is already open
Next 'go to the next open excel workbook
'make the directory to save the bulkupload file to. create it if it doesnt already exist.
If Dir(WBpath, vbDirectory) <> "" Then 'check is the folder already exists
ChDir WBpath 'change the directory to WBPath
If Dir(WBpath & "\BulkUploadFiles\", vbDirectory) = "" Then
MkDir "BulkUploadFiles" 'create the output folder
End If
Set NewBook = Workbooks.Add 'create the output workbook
With NewBook 'set the properties for the output workbook
.Title = WBName 'add the workbook title
.Subject = WBName 'add the workbook subject
.SaveAs filename:=WBFile, FileFormat:=xlCSV, local:=True 'save the output workbook to the assigned directory as a CSV file
End With 'done setting file properties
End If
If Dir(WBpath2, vbDirectory) <> "" Then 'check is the folder already exists
ChDir WBpath2 'change the directory to WBPath2
If Dir(WBpath2 & "\BulkUploadFiles\", vbDirectory) = "" Then
MkDir "BulkUploadFiles" 'create the output folder
End If
Set NewBook = Workbooks.Add 'create the output workbook
With NewBook 'set the properties for the output workbook
.Title = WBName 'add the workbook title
.Subject = WBName 'add the workbook subject
.SaveAs filename:=WBFile2, FileFormat:=xlCSV, local:=True 'save the output workbook to the assigned directory as a CSV file
End With 'done setting file properties
End If
Workbooks(WBName).Sheets("BulkUpload" & UserForm1.TextBox5.value).Name = "Sheet1" 'rename the first sheet in the output workbook back to Sheet1 so we can reference it correctly later
Workbooks(WBName).Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sheet3" 'add a new sheet to the output workbook
Workbooks(WBName).Sheets("Sheet3").Visible = xlSheetHidden 'hide the new sheet we just made (Sheet3)
on my workstation (with one drive installed) this works fine but on other users pcs i receive an error when attempting to create the folder and fil
Instead of this:
ChDir WBpath 'change the directory to WBPath
If Dir(WBpath & "\BulkUploadFiles\", vbDirectory) = "" Then
MkDir "BulkUploadFiles" 'create the output folder
End If
You can skip the ChDir and just use something like this:
fPath = WBpath & "\BulkUploadFiles"
If Dir(fPath, vbDirectory) = "" Then
MkDir fPath
End If
ChDir does not set the working folder if the user's current working folder is on a different drive
EDIT: this worked for me but I'm not sure what you want to do when adding multiple sheets to a CSV-format file, since a CSV can have only one "sheet"
Dim deskTop, wbName As String, folderName As String, newBook As Workbook
Dim txtVal As String
txtVal = UserForm1.TextBox5.Value
deskTop = CreateObject("Wscript.Shell").specialfolders("Desktop")
wbName = "BulkUpload" & txtVal & ".csv" 'the name of the file
'close the workbook if it's open
On Error Resume Next 'ignore error if the file is not open
Workbooks(wbName).Close
On Error GoTo 0 'stop ignoring errors
folderName = deskTop & "\BulkUploadFiles\"
If Len(Dir(folderName, vbDirectory)) = 0 Then MkDir folderName
Set newBook = Workbooks.Add 'create the output workbook
With newBook
.Title = wbName
.Subject = wbName
.SaveAs Filename:=folderName & wbName, FileFormat:=xlCSV, local:=True
.Sheets(1).Name = "Sheet1"
'??? a csv file can't have multiple sheets...
'.Sheets.Add(After:=.Worksheets(.Worksheets.Count)).Name = "Sheet3"
'.Worksheets(.Worksheets.Count).Visible = xlSheetHidden
End With
Here is my updated code. I tried using if statements to validate the path but this is still failing on every workstation except mine.
Dim NewBook As Variant
Dim WBpath, WBpath2, WBName, WBFile, WBFile2, WBDir, WBDir2, Fpath, Fpath2 As String
Dim User As String
Dim WS As Worksheet
Dim wb As Workbook
User = Environ("Username") 'set the current users username to the User variable
WBpath = "C:\Users\" & User & "\OneDrive - CompanyName\Desktop" 'windows directory where the file will go
WBpath2 = "C:\Users\" & User & "\Desktop" 'windows directory where the file will go
WBName = "BulkUpload" & UserForm1.TextBox5.value & ".csv" 'the name of the file
WBFile = WBpath & "\BulkUploadFiles\" & WBName 'full file path we will be saving the file in
WBFile2 = WBpath2 & "\BulkUploadFiles\" & WBName 'full file path we will be saving the file in
For Each wb In Workbooks 'loop through each open excel workbook and perform the below action
If wb.Name = WBName Then 'perform the below action only if the currently selected workbook has the same name as the output workbook
Workbooks(WBName).Close 'close the selected excel workbook
End If 'done checking if the file is already open
Next 'go to the next open excel workbook
'make the directory to save the bulkupload file to. create it if it doesnt already exist.
Fpath = WBpath & "\BulkUploadFiles\"
If Dir(WBpath2, vbDirectory) <> "" Then
If Dir(Fpath, vbDirectory) = "" Then
MkDir Fpath
Set NewBook = Workbooks.Add 'create the output workbook
With NewBook 'set the properties for the output workbook
.Title = WBName 'add the workbook title
.Subject = WBName 'add the workbook subject
.SaveAs filename:=WBFile, FileFormat:=xlCSV, local:=True 'save the output workbook to the assigned directory as a CSV file
End With 'done setting file properties
End If
End If
Fpath2 = WBpath2 & "\BulkUploadFiles\"
If Dir(WBpath2, vbDirectory) <> "" Then
If Dir(Fpath2, vbDirectory) = "" Then
MkDir Fpath
Set NewBook = Workbooks.Add 'create the output workbook
With NewBook 'set the properties for the output workbook
.Title = WBName 'add the workbook title
.Subject = WBName 'add the workbook subject
.SaveAs filename:=WBFile2, FileFormat:=xlCSV, local:=True 'save the output workbook to the assigned directory as a CSV file
End With 'done setting file properties
End If
End If
Workbooks(WBName).Sheets("BulkUpload" & UserForm1.TextBox5.value).Name = "Sheet1" 'rename the first sheet in the output workbook back to Sheet1 so we can reference it correctly later
Workbooks(WBName).Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sheet3" 'add a new sheet to the output workbook
Workbooks(WBName).Sheets("Sheet3").Visible = xlSheetHidden 'hide the new sheet we just made (Sheet3)
I am trying to output a copy of a workbook as a CSV File. I have the code below but on saving it comes up in file type as Excel workbook.
Sub SAVE_CSV()
Dim FileName As String
FileName = "CSV Import File"
Dim fPth As Object
Set fPth = Application.FileDialog(msoFileDialogSaveAs)
With fPth
.InitialFileName = FileName
.Title = "Save Your Import File"
.InitialView = msoFileDialogViewList
If .Show <> 0 Then
ThisWorkbook.SaveAs FileName:=.SelectedItems(1) & "*.csv", FileFormat:=xlCSV
End If
End With
You know the name you want to save it as, so maybe it's just a case of selecting the right folder:
Sub SAVE_CSV()
Dim FileName As String
FileName = "CSV Import File Again"
Dim fPth As Object
Set fPth = Application.FileDialog(msoFileDialogFolderPicker)
With fPth
.InitialFileName = "C:\Users\Testing\Documents\Can be deleted\" 'Change as required.
.Title = "Save Your Import File"
.InitialView = msoFileDialogViewList
If .Show <> 0 Then
ThisWorkbook.SaveAs FileName:=.SelectedItems(1) & "\" & FileName & ".csv", FileFormat:=xlCSV
End If
End With
End Sub
Replace with:
ThisWorkbook.SaveAs FileName:=.SelectedItems(1) & ".csv"
Follow the below logic:
Path - Directory
"\"
File Name
File type - .csv
I found code in this discussion which has been extremely helpful for exporting Excel sheets as a new workbook. I've posted the version of the code that I currently use below.
As this code stands, it copies the content of the desired sheet to a new workbook, formulas and all.
Is it possible to modify this code to copy values only to this new workbook?
I appreciate any insight anyone can lend.
Sub ExportXLSX()
'exports desired sheet to new XLSX file
Dim MyPath As String
Dim MyFileName As String
Dim DateString As String
DateString = Format(Now(), "yyyy-mm-dd_hh_mm_ss_AM/PM")
MyFileName = DateString & "_" & "Whatever You Like"
If Not Right(MyFileName, 4) = ".xlsx" Then MyFileName = MyFileName & ".xlsx"
Sheets("Desired Sheet").Copy
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Where should we save this?"
.AllowMultiSelect = False
.InitialFileName = "" '<~~ The start folder path for the file picker.
If .Show <> -1 Then GoTo NextCode
MyPath = .SelectedItems(1) & "\"
End With
NextCode:
With ActiveWorkbook
.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close False
End With
End Sub
See revised NextCode section for solution:
NextCode:
With ActiveWorkbook
.ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value '<~~ converts contents of XLSX file to values only
.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close False
End With