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
Related
Me again , I'm trying to code for spliting sheets in the xlsm file into the seperate sheet then save them in the same place with the xlsm file. the code as below:
Sub splitsheet()
Dim path As String
Dim cities
ReDim cities(1 To ThisWorkbook.Worksheets.Count)
Dim i As Long
Dim sh As Worksheet
path = ActiveWorkbook.path
For i = 1 To Worksheets.Count
cities(i) = Sheets(i).Name
ActiveWorkbook.SaveAs _
Filename:=path & "\" & Sheets(i).Name & ".xlsx"
'ActiveWorkbook.Close False
Next i
End Sub
The error in my photo below. Why it can not save as in "xlsx" extension , above code is work fine with "xlsm" extension
Filename:=path & "\" & Sheets(i).Name & ".xlsm" 'it can work fine with xlsm extension
My question is how can save as in "xlsx" extension in this case. All assist/explaination will be appriciated.
Please try this code.
Sub EachSheetToEachOwnWorkbook()
' 286
Dim Path As String
Dim Ws As Worksheet
Application.ScreenUpdating = False
Path = ThisWorkbook.Path & "\"
For Each Ws In ThisWorkbook.Worksheets
Ws.Copy
With ActiveWorkbook
.SaveAs Filename:=Path & Ws.Name & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
.Close
End With
Next Ws
Application.ScreenUpdating = True
End Sub
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
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
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