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.
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
ok so this is a short peace in a big workbook... All i am trying to do is tell it a certain place to save.
ActiveWorkbook.SaveCopyAs _
FileName:=ActiveWorkbook.Path "\OLD " & Range("D1").Value & ".XLSM"
This does exactly as it is supposed to however, i want to say basically
"activeworkbook.path" plus give it one further step and designate a folder called "old" that it will go to.
in essence it would look like this
\documents\test\my-file.xlsm
to this
\documents\test\OLD\my-file.xlsm
any hints?
You have a space in "\OLD ", and you are not closing off \OLD to be a folder.
The line should look like
ActiveWorkbook.SaveCopyAs _
FileName:=ActiveWorkbook.Path & "\OLD\" & Range("D1").Value & ".XLSM"
I would also strongly consider qualifying your Range("D1") with your worksheet.
Dim fileNameRng as range
Set fileNameRng = thisworkbook.worksheets("Sheet1").Range("D1")
ActiveWorkbook.SaveCopyAs _
FileName:=ActiveWorkbook.Path & "\OLD\" & fileNameRng.Value & ".XLSM"
Trying to get Excel to "saveas" a workbook by using the following code:
Sub SaveWorkbook(my_FileName, sFolder)
Dim workbook_Name As String
Dim fName As String
fName = CStr(Range("B9").Value)
workbook_Name = "\" & fName & ".xls"
Workbooks(my_FileName).SaveAs fileName:=sFolder & workbook_Name
End Sub
my_FileName and sFolder are being passed by another function:
Sub ProduceDoc()
MsgBox "Please Select the File that Contains the Document"
my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*,*.xsl*,*.xm*")
sFolder = "C:\Users\" & InputBox("Please type your employee id") & "\Desktop\" & InputBox("What will you name your folder?")
Workbooks.Open (my_FileName)
SaveWorkbook (my_FileName)
End Sub
The subscript error is currently being thrown for the line:
Workbooks(my_FileName).SaveAs fileName:=sFolder & workbook_Name
and I can't figure out why. I'm assuming it's happening because I'm forgetting something simple.
What I've done so far to test:
Verified that my_FileName is successfully being passed to the function SaveWorkbook(), and it is. I was able to open the document specified in function ProduceDoc() and get my_FileName to print in a certain cell within SaveWorkbook()
That's all I have in the toolkit atm. Any thoughts?
Edit: I've now updated the line Workbooks(my_FileName).SaveAs fileName:=sFolder & workbook_Name to show new state, and also sFolder is being called in . It is still giving the same error.
I figured it out.
Everything was formatted correctly in all variables, except for these two lines:
workbook_Name = "\" & fName & ".xls"
Workbooks(my_FileName).SaveAs fileName:=sFolder & workbook_Name
Excel didn't like a few things here, so I tried to make it as basic as I could. I combined the concatenation of sFolder and workbook_Name into one variable, removed ".xls", and added the fileFormat:=xlWorkbookNormal argument into the SaveAs method.
What I think really fixed this is how I called the SaveAs method. Changed that to "ActiveWorkbook" rather than what is was previously.
workbook_Name = sFolder & "\" & fName
ActiveWorkbook.SaveAs fileName:=workbook_Name, fileFormat:=xlWorkbookNormal
It all behaves as expected now!
hope this helps anyone who runs into this in the future!
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.
I created an Excel Add-In that is used on a workbook with imported data. I need to add code that will do the following:
Check if folder exists C:\Users\\My Documents\ Extract
Files\
Create the folder if it does not exist
Save the file into this folder with current date and time (Now) in the file name with an .xlsx extension.
Example: C:\Users\jdoe\My Documents\Extract Files\Extract - 01-15-2016 15:15.xlsx
I have found this, but need to know how to get my criteria above into this code:
ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlOpenXMLWorkbook
I do not know enough about VBA to create a folder if it does not exist (if you can do this with VBA). I have looked but could not find anything that was helpful. Asking for some guidance here. Thanks.
Try this code:
Sub Ex()
If InStr(LCase$(ActiveWorkbook.name), "extract") > 0 Then
Exit Sub
Else
Dim MyDir As String, fn As String
MyDir = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Extract Files" ' change this to valid path
If Len(Dir(MyDir, vbDirectory)) = 0 Then MkDir MyDir
fn = MyDir & "\Extract - " & Format(Now, "mm-dd-yyyy hh_mm")
ActiveWorkbook.SaveAs Filename:=fn, FileFormat:=xlOpenXMLWorkbook
End If
End Sub
we can not use : in the file name
Give this a try:
Sub dural()
Dim folder As String, myFileName As String
folder = "C:\TestFolder\Extract Files"
On Error Resume Next
MkDir folder
On Error GoTo 0
myFileName = folder & "\" & "Extract - " & Format(Now, "mm-dd-yyyy hh mm") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlOpenXMLWorkbook
End Sub
after changing the folder name.................if you get a warning, click on the yes button
The macro will create the folder if it does not exist.