I have the following macro that exports a current excel sheet with some data to a new workbook into a specific path. The trouble i have, is that i want to protect that workbook new sheet after is created. How it can be done? I tried using ActiveWorkbook.Protect "Password" but did not worked.
Sub NuevoDia()
Dim FilePath As String
Dim NewName As String
FilePath = "C:\Users\Pol\Desktop\": NewName = FilePath & "Registros " & Format(Date, "DD-MM-YYYY") & ".xls"
Sheets("Registros").Select
Hoja3.Unprotect "LOG2020"
Sheets("Registros").Copy
ActiveWorkbook.SaveAs Filename:=NewName, FileFormat _
:=xlWorkbookNormal, CreateBackup:=False
End Sub
Thanks for the help!
To protect a sheet I would suggest to do :
Sheets("Registros").Protect "password"
And if you wanted to protect workbook since you tried :
ActiveWorkbook.Protect Password:="password", Structure:=True, Windows:=True
Also note that it is better to not use select so
Sheets("Registros").Select
Hoja3.Unprotect "LOG2020"
Sheets("Registros").Copy
do the same as
Hoja3.Unprotect "LOG2020"
Sheets("Registros").Copy
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
New to VBA and have an assignment to create a sub that pastes from one workbook into a new workbook. A requirement for saving the file is that "the folder path be universal so other people can create this folder too". What amendment would I make to the ActiveWorkbook.SaveAs method to fulfill this? Thanks
Sub pasteTable()
Dim formatting As Variant 'create variable to hold formatting2 workbook path
formatting = Application.GetOpenFilename() 'user is prompted and selects path to formatting2 workbook and assigns to formatting variable
Workbooks.Open formatting 'formatting2 workbook is now active
Worksheets("Formatting").Range("B3:R13").Copy 'copies table from formatting2 workbook
Workbooks.Add 'add new workbook
Worksheets(1).Range("B3:R13").Select 'selects range on worksheet of new workbook to paste table
Selection.PasteSpecial xlPasteAll 'pastes table
Columns("B:R").ColumnWidth = 20 'ensures table has proper row and column heights/widths
Rows("3:13").RowHeight = 25
Worksheets(1).Name = "Table Data" 'renames worksheet
ActiveWorkbook.SaveAs "C:\Users\name\Desktop\names Excel Assessment VBA\names Excel Assessment VBA " & Format(Date, "dd/mmm/yyyy"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
'saves workbook according to desired specifications
End Sub
Change your Save line to this:
ActiveWorkbook.SaveAs "C:\Users\" & Environ("Username") & "\Desktop\Excel Assessment VBA\Excel Assessment VBA " & Format(Date, "dd-mmm-yyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
The Username system variable will adjust depending on the Windows account that is in use. Just make sure each user has those folders existing on their desktop too, or you will get an error. I also removed names from the folder names as i assume you were trying to do something with the username there as well. You can adjust that to your needs.
Your Date format needed to change too as it was including illegal characters.
You also forgot to include a file extension, so I added that as well.
There is a lot going on with that line, including a lot of mistakes, so you are going to have to play with it a bit until you get exactly what you need. You may want to simplify it a bit until you get the hang of all those things.
I think you have to add some more checks
The script expects the name of the tool-path-folder as constant ToolFolder.
Plus a second constant ToolBaseFolder that could be set to the parent-path `ToolFolder, e.g. a network path. If the const is empty, users desktop will be used.
If this path does not yet exist it will be created.
Option Explicit
Private Const ToolBaseFolder As String = "" 'if ToolBaseFolder is an empty string desktop will be used instead
Private Const ToolFolder As String = "MyNameForToolFolder"
Public Sub testWbToToolFolder()
'this is just for testing
Dim wb As Workbook: Set wb = ActiveWorkbook
saveWbToToolFolder wb, "test.xlsx"
End Sub
Public Sub saveWbToToolFolder(wb As Workbook, filename As String)
'you don't need this sub - but have the same code line in your main routine
wb.SaveAs getToolFolder & filename
End Sub
Public Function getToolFolder() As String
'this returns the toolfolder e.g. C:\Users\xyz\Desktop\MyNameForToolFolder
Dim basepath As String
basepath = ToolBaseFolder & "\"
If existsFolder(basepath) = False Then
If LenB(ToolBaseFolder) > 0 Then
MsgBox ToolBaseFolder & " does not exist." & vbCrLf & _
"File will be saved to " & ToolFolder & " on desktop ", vbExclamation
End If
basepath = getDesktopFolderOfUser
End If
Dim fullpath As String
fullpath = basepath & ToolFolder & "\"
If existsFolder(fullpath) = False Then
makeFolder fullpath
End If
getToolFolder = fullpath
End Function
Private Function existsFolder(path As String) As Boolean
If Len(path) < 2 Then Exit Function 'can't be a valid folder
existsFolder = LenB(Dir(path, vbDirectory)) > 0
End Function
Private Function getDesktopFolderOfUser() As String
getDesktopFolderOfUser = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
End Function
Private Function makeFolder(path As String)
'https://stackoverflow.com/a/26934834/16578424 plus comment from rayzinnz
CreateObject("WScript.Shell").Run "cmd /c mkdir """ & path & """", 0, True
End Function
Thanks for everyone that answers questions on here. I use this site all the time. I'm not formally trained but have put together some stuff in the past.
Here is what my Code accomplishes. I have a macro enabled excel file that I store in SharePoint. My users edit the excel and run a macro that saves their changes into a CSV File that we use to Import into JIRA. I've been able to create the macro to do all this and it works great when I used it. But when others in my group use it they are getting a "Can't execute in break mode" error. I think I'm missing some validation code but I'm not sure how to achieve this. Any help would be greatly appreciated! I'm so close!!
'''
Sub Save_CSV_Debugger()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
'Makes a copy of the Worksheet
ws.Copy
'Creates New FileName - Concatenates username and Desktop path with for
New Name
NewName = Environ("USERPROFILE") & "\Desktop\" & Range("A2").Value & " -
JIRA Import" & ".CSV"
Application.DisplayAlerts = False
'Saves WB with NewFileName
ActiveWorkbook.SaveAs Filename:=NewName, _
FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
'Hides saves dialog
If SaveAsUI = True Then Cancel = True
' Shows user a message
MsgBox "File saved to Desktop for JIRA Import " & vbNewLine & NewName
ActiveWorkbook.Close
'Reopens CSV File Without Macro - Clean CSV
Application.Workbooks.Open (NewName)
End Sub
'''
I have the following code:
Sub SaveFinalMTO()
Application.ScreenUpdating = False
Sheets("Final MTO").Select
Sheets("Final MTO").Copy
'grab the file name from b6:m6, put it in variable ThisFile
ThisFile = Sheets("Final MTO").Range("b6:m6").Value
Sheets("Final MTO").SaveAs Filename:="C:\Users\owner\Desktop\" & ThisFile & ".xlsm"
Application.ScreenUpdating = True
ActiveWorkbook.Close
End Sub
Everything works fine to an extent. The new workbook is created with the correct sheet. The new file is opened but the file name is "Book1" instead of the values in range B6:M6 which is a merged cell using a concatenate function. I tried using an unmerged with just a value, I was still pulling up a
run time error "13"
Any help solving this error would be much appreciated. Thank you.
If you are going to save as a macro enabled file type, then you have to specify that. Also, you can make the folder name dynamic using Environ$.
Sheets("Final MTO").SaveAs Filename:="C:\Users\" & Environ$("Username") & "\Desktop\" & ThisFile & ".xlsm", xlOpenXMLWorkbookMacroEnabled
XlFileFormat Enumerations
I am trying to delete the contents of few cell in the saved copies of my workbook that is under different file names. As code below, this is deleting the content from original workbook and retaining the content in the saved wb. It is doing the right opposite task that I wanted for!
Also, any suggestion on how to disable few modules and delete few pictures in the saved wb ?
Thanks in Advance for help !
Sub SaveAsNewCopy()
Dim Path As String
Dim FileName1 As String
Application.DisplayAlerts = False
FileName1 = Range("D3")
ThisWorkbook.SaveCopyAs FileName:="C:\Users\..\..\..\" & FileName1 & "-" & "List" & ".xlsm"
MsgBox "File Saved successfully!", , "Save"
ThisWorkbook.Sheets("Sheet1").Range("E5:F5").ClearContents
ThisWorkbook.Sheets("Sheet1").Range("E9:F9").ClearContents
Application.DisplayAlerts = True
End Sub
You need to get a handle on the workbook you just saved, make the changes you want and then save it again. The easiest way to do this is to assign a variable to it. In your declarations do something like this:
Dim wb as Workbook
then before your save-as line assign the saved workbook to that variable like this:
Set wb = ThisWorkbook.SaveCopyAs FileName:="C:\Users......\" & FileName1 & "-" & "List" & ".xlsm"
Then you can work with wb as required as save it with wb.Save True etc etc