I'm converting CSVs to XLSMs using a new temporary file with the following SUB.
sub a()
j=array("apple","orange")
for each i in j
workbooks.open environ("userprofile") & "\desktop\" & i & ".csv"
activeworkbook.saveas environ("userprofile") & "\desktop\" & i & ".xlsm", xlopenxmlworkbookmacroenabled
activeworkbook.close
next i
end sub
I wonder whether I can include this SUB to each of the new XLSMs. Thanks.
Related
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'm trying to help my mum remotely with her problem: she needs to save a workbook as an xlsx and a PDF. Here's my code:
Sub sb_Copy_Save_ActiveSheet_As_Workbook()
Dim wksht As Worksheet
Set wksht = ActiveSheet
Dim path As String
path = "C:\Users\" & Environ$("Username") & "\Company Name\Company Name Team Site - Documents\PO Numbers\"
wksht.Copy
ActiveWorkbook.SaveAs Filename:=path & wksht.Range("G1") & " " & wksht.Range("F1").Value & ".xlsx"
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF FileName:=path & wksht.Range("G1") & " " & wksht.Range("F1").Value & ".pdf" Quality:=xlQualityStandard OpenAfterPublish:=True
End Sub
We got it working to the point where she can save an xlsx file in the specified filepath, but attempting to export it as a PDF isn't working. She says she's getting a syntax error, but as I don't have excel myself I can't test it. I've looked at some similar questions but I can't seem to find an answer.
Thanks very much in advance
you just need to add commas so that
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF FileName:=path & wksht.Range("G1") & " " & wksht.Range("F1").Value & ".pdf" Quality:=xlQualityStandard OpenAfterPublish:=True
becomes
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:=path & wksht.Range("G1") & " " & wksht.Range("F1").Value & ".pdf", Quality:=xlQualityStandard, OpenAfterPublish:=True
Once I am complete with my reporting in Excel, I'd like to SaveAs a new Sheet into a new workbook into the same location as the PDF created (a subfolder).
I will email the Excel file to a client and they can edit and return so the client's data doesn't have to be transposed and the form will look just like the PDF essentially.
Also, the output file name will need to be the same as the existing output PDF file (cell data supplies this) so that the file is not lost due to renaming issues, and will match the transmittal.
The code I have creates subfolders, and organizes everything in them with a resulted PDF, however I cannot get an Excel file too that is text only (the one method I found copies the macro buttons, formulas linking to the original file, etc.).
I want the formatting, not the cell formulas, just the cell text.
Sub SCL_SaveAndFile()
Dim myDir As String, mySht As String, mySubDir As String, mySubSub As String, mySubName As String, mySubName1 As String
'Example of current Folder Structure
'C:\RFP Documents\[RFP NUMBER]\[CLIENT NAME]\[DOCUMENT TITLE]\Document.pdf
'Would also like this, of just the active sheet, with just text no formulas copied
'C:\RFP Documents\[RFP NUMBER]\[CLIENT NAME]\[DOCUMENT TITLE]\Document.xslx
myDir = "C:\RFP Documents\" 'root destination
mySubDir = ActiveSheet.Range("R3").Value 'rfp number
mySubSub = ActiveSheet.Range("R2").Value 'client name
mySubName = ActiveSheet.Range("A1").Value 'document title
mySubName1 = "RFP PACKAGE" 'sub folder where documents are stored to be emailed to client
mySht = ActiveSheet.Range("R1").Value 'document no or filename
On Error Resume Next
MkDir myDir
MkDir myDir & "\" & mySubDir
MkDir myDir & "\" & mySubDir & "\" & mySubSub & "\" & mySubName1
MkDir myDir & "\" & mySubDir & "\" & mySubSub & "\" & mySubName1 & "\" & mySubName
On Error GoTo 0
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
filename:=myDir & "\" & mySubDir & "\" & mySubSub & "\" & "\" & mySubName1 & "\" & mySubName & "\" & mySht, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Add this Below you Code:
Copy the Activesheet
Paste Special all the Formats and Values
Save the Newly Created workbook at the same Destination
Dim nwb As Workbook, wb As Workbook, wks As Worksheet
Set wb = ActiveWorkbook
Set wks = ActiveSheet
wks.Copy
Set nwb = ActiveWorkbook
With nwb.Worksheets(1)
.UsedRange.Copy
.Range("A1").PasteSpecial xlPasteValues
.Range("A1").PasteSpecial xlPasteFormats
End With
nwb.SaveAs fileName:=myDir & "\" & mySubDir & "\" & mySubSub & "\" & "\" & mySubName1 & "\" & mySubName & "\" & mySht & ".xlsx"
nwb.Close
Full Code
Sub SCL_SaveAndFile()
Dim myDir As String, mySht As String, mySubDir As String, mySubSub As String, mySubName As String, mySubName1 As String
Dim nwb As Workbook, wb As Workbook, wks As Worksheet
Set wb = ActiveWorkbook
Set wks = ActiveSheet
myDir = "C:\RFP Documents\" 'root destination
mySubDir = ActiveSheet.Range("R3").Value 'rfp number
mySubSub = ActiveSheet.Range("R2").Value 'client name
mySubName = ActiveSheet.Range("A1").Value 'document title
mySubName1 = "RFP PACKAGE" 'sub folder where documents are stored to be emailed to client
mySht = ActiveSheet.Range("R1").Value 'document no or filename
On Error Resume Next
MkDir myDir
MkDir myDir & "\" & mySubDir
MkDir myDir & "\" & mySubDir & "\" & mySubSub & "\" & mySubName1
MkDir myDir & "\" & mySubDir & "\" & mySubSub & "\" & mySubName1 & "\" & mySubName
On Error GoTo 0
wks.ExportAsFixedFormat Type:=xlTypePDF, _
fileName:=myDir & "\" & mySubDir & "\" & mySubSub & "\" & "\" & mySubName1 & "\" & mySubName & "\" & mySht, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
wks.Copy
Set nwb = ActiveWorkbook
With nwb.Worksheets(1)
.UsedRange.Copy
.Range("A1").PasteSpecial xlPasteValues
.Range("A1").PasteSpecial xlPasteFormats
End With
nwb.SaveAs fileName:=myDir & "\" & mySubDir & "\" & mySubSub & "\" & "\" & mySubName1 & "\" & mySubName & "\" & mySht & ".xlsx"
nwb.Close
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
I tried to search and put together a code to fit my purpose.
Sub save()
ActiveWorkbook.SaveAS Filename:="C:\-docs\cmat\Desktop\New folder\ck.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub
How to edit this to:
Instead of naming the saved file ck.xls, generate the filename from the worksheet cells C5 and C8, with a space in the middle.
try
Sub save()
ActiveWorkbook.SaveAS Filename:="C:\-docs\cmat\Desktop\New folder\" & Range("C5").Text & chr(32) & Range("C8").Text &".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub
If you want to save the workbook with the macros use the below code
Sub save()
ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("username") & _
"\Desktop\" & Range("C5").Text & Chr(32) & Range("C8").Text & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, Password:=vbNullString, WriteResPassword:=vbNullString, _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
if you want to save workbook with no macros and no pop-up use this
Sub save()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("username") & _
"\Desktop\" & Range("C5").Text & Chr(32) & Range("C8").Text & ".xls", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
End Sub
Ok, at that time got it done with the help of a friend and the code looks like this.
Sub Saving()
Dim part1 As String
Dim part2 As String
part1 = Range("C5").Value
part2 = Range("C8").Value
ActiveWorkbook.SaveAs Filename:= _
"C:\-docs\cmat\Desktop\pieteikumi\" & part1 & " " & part2 & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
How do I edit this part (FileFormat:= _ xlOpenXMLWorkbookMacroEnabled) for it to save as Excel 97-2013 Workbook, have tried several variations with no success.
Thankyou
Seems, that I found the solution, but my idea is flawed. By doing this FileFormat:= _ xlOpenXMLWorkbook, it drops out a popup saying, the you cannot save this workbook as a file without Macro enabled. So, is this impossible?