Found the below code online, though it's a bit strange when I run the macro for dates as my dates will convert from:
[DD/MM/YYYY] to [MM/DD/YYYY]
example:
31/07/2017 to 07/31/2017.
anyone able to assist, I would want to keep it was [DD/MM/YYYY].
Refer to below:
Dim strName As String
Dim filepath As String
Application.ScreenUpdating = False
strName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & " " & ActiveSheet.Name & ".csv"
ActiveSheet.Copy 'copy the sheet as a new workbook
ActiveWorkbook.SaveAs Filename:=strName, FileFormat:=xlCSV
ActiveWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
MsgBox "File has been Created and Saved as: " & vbCr & strName, , "Copy & Save Report"
thanks,
Depending on your local language settings (specified in Control Panel), the following should work:
ActiveWorkbook.SaveAs Filename:=strName, FileFormat:=xlCSV, Local:=True
This should ideally be used by specifying the TextCodepage parameter of the SaveAs method.
However, according to MSDN reference, this parameter is ignored for all languages of Excel.
A previous question on SO addresses this, and suggests instead using FileFormat:=xlUnicodeText, and then setting the extension to .csv, i.e.:
ActiveWorkbook.SaveAs Filename:=strName & ".csv", FileFormat:=xlUnicodeText
However, this does not seem to work for my part when testing your scenario.
Related
Was after some input that I have so far had trouble figuring out on my own...
If I wanted the location (i.e. C:\Users\SB\Documents\CSV Uploads) to be stored in another sheet (LOOKUP DATA), in cell "C13" (Defined Name: FOLDERLOCATION) and used instead of having it in the code, can this be done?
While the below works to export the sheet to a CSV file to the folder I have specified, the file ends up being a lot larger than I expected. The file ends up being over 9mb! The weird thing is if I open, then save the file again and close, it drops down to around 38kb. Any ideas what I am doing wrong here?
Thanks in advance, I look forward to seeing what you experts think!
Sub EXPORTCSV()
Dim Path As String
Dim filename As String
Sheets("UPLOAD").Visible = True
Sheets("UPLOAD").Copy
ActiveWorkbook.SaveAs ("C:\Users\SB\Documents\CSV Uploads\UPLOAD - IB " & Format(Now(), "YYYYMMDD - hh_mm_ss AMPM") & ".csv") _
, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
End Sub
With regards to your point 1, yes, you can use a cell to store the root path. I have rewritten some of your code for clarity, but if you want to keep the same structure that you already have, just replace the ActiveWorkbook.SaveAs ("C:\Users\SB\Documents\CSV Uploads\UPLOAD - IB " & Format(Now(), "YYYYMMDD - hh_mm_ss AMPM") & ".csv"), FileFormat:=xlCSV, CreateBackup:=False
with
ActiveWorkbook.SaveAs (ActiveWorkbook.Sheets("UPLOAD").Range("C13").Value & Format(Now(), "YYYYMMDD - hh_mm_ss AMPM") & ".csv"), FileFormat:=xlCSV, CreateBackup:=False
A few other notes:
Using ThisWorkbook rather than ActiveWorkbook is safer because it will always refer to the workbook that the VBA code is residing in rather than whichever workbook happens to be active at the time.
Be careful with the Workbook.Close method, especially since there is no confirmation to close. You could easily lose your work, and since CSV files don't save VBA code, it would be even worse.
Private Sub EXPORTCSV_MOD()
' Parameters of the file path
Dim Path As String, Filename As String, Extension As String
Path = ThisWorkbook.Sheets("UPLOAD").Range("C13").Value
Filename = Format(Now(), "YYYYMMDD - hh_mm_ss AMPM")
Extension = ".csv"
' Assemble the full file path
Dim FullPath As String
FullPath = Path & Application.PathSeparator & Filename & Extension
' Save and close the workbook
ThisWorkbook.SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=False
ThisWorkbook.Close
End Sub
Thx #TehDrunkSailor, with a slight tweak using your logic, this resolved my code, you legend!! The reason I am using Active and not This is because I am saving the copied sheet into a new workbook, not the workbook I have been working in.
Sub EXPORTCSV()
Dim Path As String
Dim filename As String
'The UPLOAD sheet was very hidden
Sheets("UPLOAD").Visible = True
'Copy to a new workbook
Sheets("UPLOAD").Copy
'Save the new workbook using data stored in the original workbook
ActiveWorkbook.SaveAs (ThisWorkbook.Sheets("LOOKUP DATA").Range("C13").Value & "UPLOAD - IB " _
& Format(Now(), "YYYYMMDD - hh_mm_ss AMPM") & ".csv"), FileFormat:=xlCSV, CreateBackup:=False
'Close the new workbook
ActiveWorkbook.Close
End Sub
This is probably a really simple task, but for some reason my code doesnt run. This code has worked for the past few months but when I initiate the command now it doesnt work.
The code that I had used (without any change) is the following:
Sub Copy()
ActiveWorkbook.SaveAs "C:\Users\[File Location]" & "File Name " & Format(Now(), "DD-MMM-YYYY") & ".xlsm", FileFormat:=52
End Sub
Wondering if anyone could provide any advice / tips on how to solve/troubleshoot >.< many thanks in advance.
Here it is broken up a little for you. The Environ() function just gets the user name of whoever is logged in when the code runs.
Replace how File1 is created if you want something else. (you did not include that part in your question)
Sub SaveIt()
Dim SavePath As String
Dim File1 As String
Dim Filename As String
SavePath = "C:\Users\" & Environ("UserName") & "\Desktop\TRD\Run\"
File1 = Split(ActiveWorkbook.Name, ".")(0) ' strip out the file extension
Filename = File1 & " " & Format(Now(), "DD-MMM-YYYY") & ".xlsm"
ActiveWorkbook.SaveAs SavePath & Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub
Note: This assumes the folder you are saving it to exists already.
EDIT: NEW BEHAVIOR - Relocating the master XLSM to a new starting directory caused all issues to disappear. Placing the XLSM into a newly created (but same name) directory in its original location had maintained no issues as well.
I am using Excel/VBA 2010. My project requires me to copy a single sheet from a master XLSM workbook that has a sheet for each user. My approach was to iterate through each sheet of the master document, create a user-specific directory and workbook, copy that user's sheet over, and then save their file. I have managed to execute this code numerous times with some success, but there is a hiccup on a few cases. Sample code below
Sub createDirectories()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Dim ws As Worksheet
Dim NewBook As Workbook
For Each ws In ThisWorkbook.Worksheets
If StrComp(ws.Name, "only_nonUser_sheet", vbTextCompare) <> 0 Then
If Not fso.FolderExists(ThisWorkbook.Path & "\" & ws.Name) Then
Set oFile = fso.CreateFolder(ThisWorkbook.Path & "\" & ws.Name)
End If
If fso.FolderExists(ThisWorkbook.Path & "\" & ws.Name) Then
If Not fso.FileExists(ThisWorkbook.Path & "\" & ws.Name & "\" & ws.Name & ".xlsm") Then
Set NewBook = Workbooks.Add
ws.Copy Before:=NewBook.Sheets(1)
'Prevents sheet name from exceeding a 31 character limit
NewBook.Sheets(Sheets(ws.Name).Index).Name = Left(ws.Name, 20) & " " & Format(Now(), "mm-dd-yyyy")
'Source of failure
NewBook.SaveAs Filename:=ThisWorkbook.Path & "\" & ws.Name & "\" & ws.Name, FileFormat:=52
NewBook.Close SaveChanges:=False
End If
End If
End If
Next ws
'Clean up file management objects
Set fso = Nothing
Set oFile = Nothing
End Sub
Folders are created without any obvious problems (despite a concern of mine below). NewBook.SaveAs produces run-time error '1004', Failed to SaveAs object "_workbook". Varying the arguments produces interesting results:
NewBook.SaveAs Filename:=ThisWorkbook.Path & "\" & ws.Name, FileFormat:=52
Properly saves the file in the same directory as the master XLSM, but not in the desired user-specific folder. This is expected.
NewBook.SaveAs Filename:=ThisWorkbook.Path & "\" & "testFolder01" & "\" & "testFile02", FileFormat:=52
Properly saves testFile02 in the testFolder01 (provided I create the directory first).
NewBook.SaveAs Filename:=ThisWorkbook.Path & "\" & "testFolder01" & "\" & ws.Name, FileFormat:=52
Properly saves ws.Name.xlsm in a pre-created folder.
NewBook.SaveAs Filename:=ThisWorkbook.Path & "\" & ws.Name & "\" & "testFile02", FileFormat:=52
Produces run-time error '1004' for the SaveAs failure.
My two hunches are:
1. Although the user-specific directories appear in File Explorer, they are not properly finished. My attempt to add oFile.Close within my fso.CreateFolder() line results in run-time error '483', and I am not sure how to address this. I have Microsoft Scripting Run-Time checked as a reference.
2. The SaveAs method does not allow for a variable path, but allows for a variable file name, which would be horrendously unfortunate and non-intuitive.
My overall path names do not exceed 150 characters total. My path/file names do not contain any illegal characters. My workbook path is on a mapped drive, but this poses no problems for my variations of my SaveAs line. My code is verbose regarding which workbook I am attempting to save. Can my code be modified to complete my task? If not, is there an alternative method of creating and saving XLSM files that allows for variable path/filenames?
Try putting NewBook.Activate before the SaveAs command. That worked for me.
I have a simple VBA that runs the same report several times while cycling through different names, saving each report as a seperate workbook.
Everything works fine, but 1 of the reports is always saved as an 'undefined' file type, and I have to manual change it to excel afterwards. All others save fine, so I can't figure out the issue. I've tried playing with the SaveAs FileFormat, but none of them have solved this.
For Each c In MCH
Detail.Range("B8:E10000").ClearContents
Data.Rows("4:4").AutoFilter Field:=2, Criteria1:= _
c.Value
lr = Data.Cells(Rows.Count, "E").End(xlUp).Row
Data.Range("E5:H" & lr).Copy Detail.Range("B8")
Sheets("Detail").Calculate
Set name = Detail.Range("B4")
Sheets("Detail").Copy
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
ActiveSheet.Range("A1").Select
Set wb = ActiveWorkbook
wb.SaveAs ThisWorkbook.Path & "\" & name
wb.Close False
Next
You didn't select the file format.
Instead of:
Set wb = ActiveWorkbook
wb.SaveAs ThisWorkbook.Path & "\" & name
Try this:
Xslx
ActiveWorkbook.SaveAs Filename:= ThisWorkbook.Path & "\" & name, FileFormat:= xlOpenXMLWorkbook, CreateBackup:=False
Text file (txt)
ActiveWorkbook.SaveAs Filename:= ThisWorkbook.Path & "\" & name, FileFormat:= xlUnicodeText, CreateBackup:=False
For other FileFormats see this enumeration:
https://msdn.microsoft.com/en-us/library/bb241279(v=office.12).aspx
In case of issues
In case you are experiencing issues with the above do the following:
Go to the Developer Tab
Click on Record Macro
Save the file manually in the desired format
Click on Stop Recording
Open your VBA Project and get the generated code
Please Help.
I want to copy just one Sheet ‘MainFinal’ among twelve other sheets(not all of the sheets in the original), to another .xls file using Excel VBA . The code I have attached below works , except it copies all worksheets and not JUST the one, and also when new file created it opens and source file is closed . Anyone have any suggestions what wrong with my code? I have tried various combinations of Worksheet, Sheets, Activesheet but without successes)?
Sub CopyMainFin()
'
' CreaMainFin Macro
'
Dim LastCopyRow As String
Dim MyStr As String
MyStr = Format(Date, "mmddyyyy")
LastCopyRow = “BT307”
Application.ScreenUpdating = False
Worksheets("MainFinal").Range("A1", LastCopyRow).Activate
Worksheets("MainFinal").Range("A1",LastCopyrow).Select
Worksheets("MainFinal").Range("A1", LastCopyRow).Copy
‘ I noticed that my rage selected
ActiveSheet.SaveAs Filename:="C:\Documents and Settings\algorn\My Documents\Excel files\" & "OutputFile" & MyStr & ".xls", CreateBackup:=False
'ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\My Documents\Excel files\" & "OutputFile" & MyStr & ".xls", CreateBackup:=False = Also not working
End Sub
This will move the named sheet into a brand new file. No extra coding needed.
Sheets("MainFinal").Copy
This line should save your new file.
Workbooks(workbooks.count).saveas _
Filename:="C:\Documents and Settings\algorn\My Documents\Excel files\" & _
"OutputFile" & MyStr & ".xls", CreateBackup:=False