So I found code on here to convert from .xls to .xlsm, but I would like to convert from .xlsx to .xlsm.
Sub TrandformAllXLSFilesToXLSM()
Dim myPath As String
myPath = "C:\Excel\"
WorkFile = Dir(myPath & "*.xls")
Do While WorkFile <> ""
If Right(WorkFile, 4) <> "xlsm" Then
Workbooks.Open FileName:=myPath & WorkFile
ActiveWorkbook.SaveAs FileName:= _
myPath & WorkFile & "m", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
End If
WorkFile = Dir()
Loop
End Sub
Here is the link
As Compo said, not close to a batch file or vbs at all.
Added this as a module to mine and and tested it in this particular path. Being a NEWB myself, I am sure there is a cleaner way to do this.
Sub XLSX2XLSM()
Dim myPath As String
myPath = "C:\Excel\"
WorkFile = Dir(myPath & "*.xlsx")
Do While WorkFile <> ""
If Right(WorkFile, 4) <> "xlsm" Then
sName = Replace(LCase(WorkFile), ".xlsx", "")
Workbooks.Open Filename:=myPath & WorkFile
ActiveWorkbook.SaveAs Filename:= _
myPath & sName & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
End If
WorkFile = Dir()
Loop
End Sub
Related
I have a simple code, which creates saves the actual file as csv file in another folder. How can I open this recently created file in notepad after the csv was created?
Here is the code, I tried with Call Shell but it didn't work.
Sub ConvertTocsv()
ChDir "S:\Back Office\Tradar\DailyReportBDP"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
("S:\Back Office\Tradar\DailyReportBDP\Custom_Daily_Report_BDP_" & Format(Now(), "YYYYMMDD") & ".csv"), FileFormat:=xlCSV, CreateBackup:=True, Local:=True
Application.DisplayAlerts = True
Information.Show
Call Shell("explorer.exe" & " " & "S:\Back Office\Tradar\DailyReportBDP", vbNormalFocus)
End Sub
Please provide some input. Thank you.
Solved it, here:
Sub ConvertTocsv()
Dim strfilename As String
strfilename = "S:\Back Office\Tradar\DailyReportBDP\Custom_Daily_Report_BDP_" & Format(Now(), "YYYYMMDD") & ".csv"
ChDir "S:\Back Office\Tradar\DailyReportBDP"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
("S:\Back Office\Tradar\DailyReportBDP\Custom_Daily_Report_BDP_" & Format(Now(), "YYYYMMDD") & ".csv"), FileFormat:=xlCSV, CreateBackup:=True, Local:=True
Application.DisplayAlerts = True
Information.Show
returnvalue = Shell("notepad.exe " & strfilename, vbNormalFocus)
ActiveWorkbook.Close SaveChanges:=False
End Sub
I have the following code which is designed so I can quick save to my desktop and then put the file into a folder. This code works fine if the file is already saved in an .xls, .csv, .xlsx or .xlsm file extension, however, when the file IS NOT saved, I only get the pop-up message boxes, and nothing happens. I was thinking about re-structuring using a CASE STATEMENT with right(activeworkbook.name, 4), but didn't know how to structure as I am not familiar with these statements. Thank you.
Sub SavetoDesktop()
'this macro will save the activesheet into the default path giving it the current name and xlsx extension
Dim fname As String
' If Right(ActiveWorkbook.Name, 5) <> ".xlsx" And Right(ActiveWorkbook.Name, 5) <> ".xls" And _
' Right(ActiveWorkbook.Name, 5) <> ".xlsm" And Right(ActiveWorkbook.Name, 5) <> ".csv" Then
If Right(ActiveWorkbook.Name, 5) = ".xlsx" Then
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xlsx", "") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=fname
Else
MsgBox "Not an .xlsx file!"
ActiveWorkbook.SaveAs Filename:="C:\Users\mmirabelli\Desktop\" & ActiveWorkbook.Name & ".xlsx"
End If
If Right(ActiveWorkbook.Name, 4) = ".csv" Then
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".csv", "") & ".csv"
ActiveWorkbook.SaveAs Filename:=fname
Else
MsgBox "Not an .csv file!"
MsgBox ActiveWorkbook.Name
End If
If Right(ActiveWorkbook.Name, 4) = ".xls" Then
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xls", "") & ".xls"
ActiveWorkbook.SaveAs Filename:=fname
Else
MsgBox "Not an .xls file!"
End If
If Right(ActiveWorkbook.Name, 5) = ".xlsm" Then
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xlsm", "") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=fname
Else
MsgBox "Not an .xlsm file!"
End If
' Else
'
' ActiveWorkbook.SaveAs Filename:="C:\Users\mmirabelli\Desktop\" & ActiveWorkbook.Name & ".xlsx"
' End If
'MsgBox Application.DefaultFilePath
'MsgBox ActiveWorkbook.Name
'
' ActiveWorkbook.SaveAs Filename:=fname
'
End Sub
thanks for the response. I tried this out and found the following: 1) The msgbox popped up when I tried saving Book1, and then it said "could not save" , and it did not save to desktop. For already saved files, I just got the "could not save" msgbox. I've never seen the "LIKE" and the "" syntax (at least in VBA, have seen in SQL). Is the like used for patterns in strings? and does the "" function as a wildcard for anything before or after? I also used a select case statement and found it was successful. I'll post below. Thanks again for the reply.
Sub SavetoDesktop()
'this macro will save the activesheet into the default path giving it the current name and xlsx extension,
' unless it already has an extension of the 4 most common formats, then it will simply save over
'(replace) the current file w a prompt
Dim fname As String
On Error GoTo errormessage
Select Case Right(ActiveWorkbook.Name, 4)
Case "xlsx"
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xlsx", "") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=fname
Case ".xls"
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xls", "") & ".xls"
ActiveWorkbook.SaveAs Filename:=fname
Case "xlsm"
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xlsm", "") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=fname
Case ".csv"
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".csv", "") & ".csv"
ActiveWorkbook.SaveAs Filename:=fname
Case Else
MsgBox "Saved to desktop as .xlsx file!"
ActiveWorkbook.SaveAs Filename:="C:\Users\mmirabelli\Desktop\" & ActiveWorkbook.Name & ".xlsx"
End Select
Exit Sub
errormessage:
MsgBox "No action", vbInformation + vbOKCancel, Time()
End Sub
Is this what you are trying to do?
Sub SavetoDesktop()
'this macro will save the activesheet into the default path giving it the current name and xlsx extension
Dim fname As String
Select Case True
Case ActiveWorkbook.Name Like "*.xlsx", _
ActiveWorkbook.Name Like "*.xlsm", _
ActiveWorkbook.Name Like "*.xls", _
ActiveWorkbook.Name Like "*.csv"
fname = Application.DefaultFilePath & "\" & ActiveWorkbook.Name
Case Else
msgBox "No file extension. Will be saved as .xlsx in the Desktop folder"
fname = Environ$("HOMEDRIVE") & Environ$("HOMEPATH") & "\Desktop\" & ActiveWorkbook.Name & ".xlsx"
End Select
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=fname
msgBox IIf(Err.Number, "Could not Save", "Saved")
Application.DisplayAlerts = True
End Sub
How can I save Sheet1 to Folder A and Sheet2 to Folder B in VBA Excel?
In my workbook I have 4 worksheets C back end and worksheet D is the interface.
Folder path are:
C:\Main Folder\Folder A\
C:\Main Folder\Folder B\
FilePath1 = "C:\Main Folder\Folder A\"
FilePath2 = "C:\Main Folder\Folder B\"
Sheets("Sheet1").Copy
Filename = ControlNumber.Value
ActiveWorkbook.SaveCopyAs FilePath1 & "\" & Filename & ".xls"
ActiveWorkbook.Close savechanges:=False
Sheets("Sheet2").Copy
Filename = ControlNumber.Value
ActiveWorkbook.SaveCopyAs FilePath2 & "\" & Filename & ".xls"
You have included path seperator twice i.e in Filepath as well as while saving the file. remove "/" from Filename or while saving
FilePath1 = "C:\Main Folder\Folder A\"
ActiveWorkbook.SaveCopyAs FilePath1 & "\" & Filename & ".xls"
your code works fine for me this way
FilePath1 = "C:\Main Folder\Folder A\"
FilePath2 = "C:\Main Folder\Folder B\"
Sheets("Sheet1").Copy
Filename = ControlNumber.Value
ActiveWorkbook.SaveAs FilePath1 & Filename & ".xls"
ActiveWorkbook.Close savechanges:=False
Sheets("Sheet2").Copy
Filename = ControlNumber.Value
ActiveWorkbook.SaveCopyAs FilePath2 & Filename & ".xls"
ActiveWorkbook.Close savechanges:=False
what errors do you get?
for testing i set:
Dim ControlNumber As Range
Set ControlNumber = Sheet1.Cells(1, 1)
Dim FilePath1 As String, FilePath2 As String, Filename As String
EDIT
On Error Resume Next
MkDir Environ("USERPROFILE") & "\Main Folder"
MkDir Environ("USERPROFILE") & "\Main Folder\Folder A\"
MkDir Environ("USERPROFILE") & "\Main Folder\Folder B\"
On Error GoTo 0
FilePath1 = Environ("USERPROFILE") & "\Main Folder\Folder A\"
FilePath2 = Environ("USERPROFILE") & "\Main Folder\Folder B\"
Sheets("Sheet1").Copy
Filename = ControlNumber.Value
ActiveWorkbook.SaveAs FilePath1 & Filename & ".xls"
ActiveWorkbook.Close savechanges:=False
Sheets("Sheet2").Copy
Filename = ControlNumber.Value
ActiveWorkbook.SaveCopyAs FilePath2 & Filename & ".xls"
ActiveWorkbook.Close savechanges:=False
I have a problem with a macro. I would like to avoid that the macro saves the PDF file even if I press on Cancel in the Save dialog box. What did I miss?
Here's the code:
Set ws = Foglio5
'enter name and select folder for file
' start in current workbook folder
strFile = Replace(Replace(Foglio5.Cells(14, 2) & "_" & (Foglio5.Cells(14, 4) & "_" & (Foglio5.Cells(15, 10))), "", ""), ".", "_") _
& "_" _
& Format(Foglio5.Cells(17, 5), "yyyymmdd\") _
& ".pdf"
strFile = ThisWorkbook.Path & "\" & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF Creato! Si trova nella cartella di questo file."
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Errore nella creazione del PDF"
Resume exitHandler
End Sub
I tried changing:
If myFile <> "False" Then
into:
If myFile Then
Now it is not working anymore and it says that it is impossible to save the PDF.
myFile <> "False"
should be
myFile <> False
ref
How to I automate the conversion of .xls workbooks to .xlsm?
You can try this code:
Sub TrandformAllXLSFilesToXLSM()
Dim myPath As String
myPath = "C:\Excel\"
WorkFile = Dir(myPath & "*.xls")
Do While WorkFile <> ""
If Right(WorkFile, 4) <> "xlsm" Then
Workbooks.Open FileName:=myPath & WorkFile
ActiveWorkbook.SaveAs FileName:= _
myPath & WorkFile & "m", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
End If
WorkFile = Dir()
Loop
End Sub
See this thread for more info