How to save a macroless copy without closing the current file? - vba

I am trying to save a copy of ThisWorkbook in xlsx while using SaveCopyAs. The problem is that SaveCopyAs saves the file as a macro enabled file, xlsb in my case which is not desired and while SaveAs does what I need, it also closes ThisWorkbook .
Is there an easier way to save in a format that does not support macros and without doing workarounds ?
Currently the best solution I found is the code snip below, but it's kinda finicky and it does not save the ContentTypeProperties that I need further on in the project, so does need to be added again.
Any ideas are appreciated, thanks!
Dim sPath as String
sPath = ThisWorkbook.FullName
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sFileName & ".xlsx", 51
Application.Workbooks.Open (sPath)
Application.DisplayAlerts = True
Exit Sub

Define your path sPath = ThisWorkbook.Path & "\" & sFileName without extension
Use ThisWorkbook.SaveCopyAs sPath & ".xlsm" to save a copy.
Open that copy with Set Wb = Application.Workbooks.Open(sPath & ".xlsm")
Save again without Wb.SaveAs sPath & ".xlsx", xlOpenXMLWorkbook
Close workbook Wb.Close SaveChanges:=False
So something like the following should work, and would keep your current code running without any re-opening side effects of the current workbook.
Dim sPath As String
sPath = ThisWorkbook.Path & "\" & sFileName 'no extension!
ThisWorkbook.SaveCopyAs sPath & ".xlsm"
Dim Wb As Workbook
Set Wb = Application.Workbooks.Open(sPath & ".xlsm")
Wb.SaveAs sPath & ".xlsx", xlOpenXMLWorkbook
Wb.Close SaveChanges:=False
And probably you want to delete the xlsm file copy
Kill sPath & ".xlsm"
You might want to make use of Application.DisplayAlerts = False and Application.ScreenUpdating = False.

Related

Converting from IQy to XLSX with VBA

I have a about 40 files that are IQy files that I can open with Excel and I'm trying to go through all of them and save them as xlsx files. What I have so far in VBA is this
Sub ConvertFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = "C:\Users\CHI\Downloads"
Filename = Dir(Pathname & ".iqy")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.SaveAs Pathname & Filename & ".xlsx"
wb.Close
Filename = Dir()
Loop
End Sub
To my understanding this loops through my download file where the iqy files are stored and then saveas in xlsx format. When I run it nothing happens.
UPDATE
Sub ConvertFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = "C:\Users\CHI\Downloads\"
Filename = Dir(Pathname & "*.iqy")
Application.DisplayAlerts = False
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.SaveAs Pathname & Filename & ".xlsx", FileFormat:=51
wb.Close
Filename = Dir()
Loop
End Sub
This is what worked for me, the only problem I have now is after it changes every file I get a prompt to import data and all I have to press is ok. Is there a way to automate this part so that I can import the data using the table option.
You need to include a wildcard in order to find your iqy files and your pathname will need an additional folder separator to allow the Open and SaveAs to work:
Sub ConvertFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = "C:\Users\CHI86786\Downloads\"
Filename = Dir(Pathname & "*.iqy")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.SaveAs Pathname & Filename & ".xlsx", FileFormat:=xlOpenXMLWorkbook
wb.Close
Filename = Dir()
Loop
End Sub
Lastly, to be sure it saves correctly, set the FileFormat parameter when using SaveAs.

SaveAs to CSV in Excel for Mac 2016

I'm experienced VBA developer but have no enough experience in Mac to complete my very simple project. I want to export sheets to CSV and save them into the same directory where workbook stored.
I already created a new workbook (ActiveWorkbook) with data copied from the main workbook and fully worked Windows part of code. But in Mac I cant make this part to work, no files created in result:
ThisWorkbook.Path & Application.PathSeparator & sheetname & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
I read few sources and found that Excel for Mac 2016 requires to call GetSaveAsFilename dialog with initial filename with manual confirmation to do it, so I modified my code like this:
#If Mac Then
s_fname = Application.GetSaveAsFilename(InitialFileName:= _
ThisWorkbook.Path & Application.PathSeparator & sheetname & ".csv")
If s_fname <> False Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs s_fname, 6
Application.DisplayAlerts = True
End If
#Else
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
ThisWorkbook.Path & Application.PathSeparator & sheetname & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
#End If
Macro creates files with data but they saved in XLSX not CSV:
and dialog have xlsx as default format:
When I'm trying to set FileFilter I have no files saved again (I assume Mac not supports this attribute). When I try to do replacement:
s_fname=replace(s_fname,".xslx",".csv")
I still have .xlsx files in the folder.
Can you suggest please which GetSaveAsFilename FileFilter value I must to set in the code to force CSV save instead of XLSX? Or anotehr VBA solution to do it (file format change, after-save renaming etc).
Thank you,
Viacheslav
Hi try to change first part as this one:
If Mac Then
OutputFile = ThisWorkbook.Path & Replace(ActiveWorkbook.Name, ".xls", "-") & ".csv"
If OutputFile <> False Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=OutputFile, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
End If

“method saveas of object _workbook failed” error while trying to save an XLSM as CSV on a mapped server

Hello, I'm trying to save a xlsm file as a CSV on a server I mapped on my computer. Here's the code:
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "Y:\"
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "Project_Type_Test" & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
VBA indicates that the bug comes form this line of code:
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "Project_Type_Test" & ".csv", FileFormat:=xlCSV
I tried to switch ActiveWorkbook by ThisWorkbook, but it did not change anything.
Thanks in advance for your help!
I ran the code and it works fine for me if I set it to my hard drive.
Sub tst()Possibly try using the url instead of the mapped dive letter
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "C:\TEMP\" 'CHANGED THIS TO BE MY HD AND WORKS FINE
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "Project_Type_Test" & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
End Sub
Possibly try using the url for the resource instead of the mapped drive letter
"\\machine\path\"
instead of "Y:\"

Saving a particular sheet from one workbook to another in a particular folder

I am trying to save a particular worksheet from my working workbook to another workbook, and trying to save it in the path of my current workbook. The saving option is in such a way that it should get saved with the dd.mm.yyyy.
I tried the following code and I am getting application defined error in the line
> newWB.SaveAs filename:=Path2 & Format(Now(), "yyyymmdd") &
> myWorksheets(i), FileFormat:=xlsx
Could you please help me figure out where I am wrong?
Sub save()
Dim myWorksheets() As String 'Array to hold worksheet names to copy
Dim newWB As Workbook
Dim CurrWB As Workbook
Dim i As Integer
Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\TT"
Set CurrWB = ThisWorkbook
myWorksheets = Split("Report", ",")
For i = LBound(myWorksheets) To UBound(myWorksheets) 'Go through entire array
Set newWB = Workbooks.Add 'Create new workbook
CurrWB.Sheets(Trim(myWorksheets(i))).Copy
newWB.SaveAs filename:=Path2 & Format(Now(), "yyyymmdd") & myWorksheets(i), FileFormat:=xlsx
newWB.Close saveChanges:=False
Next i
CurrWB.Save 'save original workbook.
End Sub
#Jenny - This code will accomplish what you ask in your question, it will save the ActiveSheet as a new file; and can be used as a function the can be called within your code. You can change the "Rpt" to identify the title of the new workbook. When I'm writing vba code, I always try to follow what my mother use to say to me, "Keep it simple".
Application.DisplayAlerts = False
Dim wbPath As String
wbPath = ThisWorkbook.Path
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=wbPath & "\" & "Rpt" & " " & Format(Date, "yyyymmdd") & ".xlsx", _
FileFormat:=51, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True

Excel VBA Convert .csv to Excel File

I have a folder which has .csv files, .xls files, and xlsx files. The below code is a portion of an overall project (when I remove the below code, the remaining code achieves what I want). A large chunk of the code was compiled from somewhere (here and around the internet). What I want the code to do is open only the .csv files in the folder, convert them to an Excel file, close the files, and then delete the .csv files in the folder. What ends up happening with the code is that one or both of the files created by the code are deleted from the folder, and I am left with nothing. Thanks in advance for any help.
Sub Test()
'
' Test Macro
'
'Set variables for the below loop
Dim MyFolder As String
Dim MyFile As String
Dim GetBook As String
Dim GetBook2 As String
Dim MyCSVFile As String
Dim KillFile As String
MyFolder = "REDACTED"
MyFile = Dir(MyFolder & "\*.xls")
MyCSVFile = Dir(MyFolder & "\*.csv")
'Open all of the .csv files in the folder and convert to .xls
Do While MyCSVFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyCSVFile
GetBook = ActiveWorkbook.Name
GetBook2 = Left(GetBook, Len(GetBook) - 4)
ActiveSheet.Name = "Sheet1"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=GetBook2, FileFormat:=56
ActiveWorkbook.Close False
Kill MyFolder & "\" & GetBook
Loop
End Sub
You are not calling the Dir function to get the next file.
Sub Test()
'Set variables for the below loop
Dim myFolder As String
Dim getBook As String
Dim myCSVFile As String
Application.DisplayAlerts = False
myFolder = Environ("TEMP") & Chr(92) & "REDACTED"
myCSVFile = Dir(myFolder & "\*.csv")
Do While myCSVFile <> ""
Workbooks.Open Filename:=myFolder & "\" & myCSVFile
getBook = ActiveSheet.Name '<~ Sheet1 of an opened CSV is the name of the CSV
ActiveSheet.Name = "Sheet1"
ActiveWorkbook.SaveAs Filename:=myFolder & Chr(92) & getBook, FileFormat:=56
ActiveWorkbook.Close False
Kill myFolder & Chr(92) & myCSVFile '<~~ delete the CSV, not the workbook
myCSVFile = Dir '<~~ this is important to get the next file in the folder listing
Loop
End Sub
The only worksheet in an opened CSV is named for the CSV (without the .CSV extension) so that can be used in the Workbook.SaveAs method. I've used xlOpenXMLWorkbook as the SaveAs FileFormat type.