I have a spreadsheet that is my template that everyone accesses. The first button I want them to hit is my Macro "Save As" button that saves in the correct spot on my SharePoint.
This works great! BUT... it overwrites without warning.
I would like to 1 - make sure it never overwrites - I would prefer it cancel the process without saving over something.
Second, I would prefer that it saves it as "[predetermined name]_copy01" where 01 can go to 99 in case the button gets tapped again by someone else after the sheet is completed by the original person (thus ruining that first person's day).
Here is my current code - how do I at least get a pop up for overwriting, and even better, get the renaming for copies (I am assuming this is some sort of "if" or "if/else" statement)
Sub Save_Workook_NewName()
Dim tillDay As Date
If Time < 11 / 24 Then
tillDay = Date - 1 + 11 / 24
Else
tillDay = Now
End If
Application.AlertBeforeOverwriting = True
Dim path As String
path = "https://ourcorporatesite.sharepoint.com/sites/tills/Shared%20Documents/Nightly%20Tills/"
ThisWorkbook.SaveAs FileName:=path & Format(Now(), "yy-mm-dd") & "_Tills.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, ReadOnlyRecommended:=False
End Sub
For making a unique file name, I am using the Username of the Excel user and the current time stamp. Thus, it makes sure that every user generates a different file name, always. Just make sure that the code runs more than 1 second (or add the 1 second wait in the name generator):
Public Function GenerateName() As String
GenerateName = Format(Now(), "yyyy_mm_dd_hh_MM_ss") & "_" & Environ("Username")
End Function
In this case, if you want to save the file it is the following: 2019_11_14_22_08_50_vityata. As a bonus, it could be easily sorted by date created.
It could be called like this:
ThisWorkbook.SaveAs Filename:=Path & GenerateName & ".xlsm"
Related
I would like to save my file with the flexible name, which will change as the cell value changes.
The one answer is here:
Save a file with a name that corresponds to a cell value
however, I want also some fixed part of the name, which won't change unlike the part described in the query above.
Basing on this solution I tried to write something as follows:
Sub Save ()
Dim name As String, Custom_Name As String
name = Range("A2").Value
Custom_Name = "NBU" & name & "- Opportunity list.xlsx"
ActiveWorkbook.SaveAs Filename:=Custom_Name
In the effect, I am getting an error:
This extension cannot be used with the selected file type. Change the file extension in the File name text box or select a different type file by changing the Save as type.
I would like to have this file in the .xlsx extension.
Excel VBA - save as with .xlsx extension
The answer above doesn't really match to my situation.
It will be vital to remove all form control buttons in the newly saved file, when possible.
Thanks & Regards,
End Sub
There is no action in the routine listed to save the file. It just simply takes the contents of a cell and creates a string with wrapped values.
I am not totally sure of what your goal is, but you need to add the action from the second link you provided. Workbook.SaveAs Method.
See the code below for a working example that I created to test.
Public Sub Save()
Dim name As String, Custom_Name As String
name = Range("A2").Value
Custom_Name = ThisWorkbook.Path & "\" & "NBU" & name & " - Opportunity list.xlsx"
'Disable alert when saving
Application.DisplayAlerts = False
'Save the workbook.
ActiveWorkbook.SaveAs Filename:=Custom_Name, FileFormat:=51
End Sub
You should note that after this code has executed, you will now be in the newly created file. This is not an export.
Test this and let me know if you have any questions. There are a few things that seem to be unnecessary in your code, but we can address those if you find this answers your first issue.
Edit:
I would also call out specifically then worksheet with the range as well.
name = Worksheets("Sheet1").Range("A2")
You said the file name is 'Opportunity v1.0.xslm'. Would it have macros? My version of Excel complains about using .xlsx if there is code in the workbook.
I have a Microsoft project vba application where I want to copy a selection of tasks using the "marked" field to identify all of the predecessor tasks to a target task, identified as the "target" below. When I have traced the network back to include only incompleted tasks, control passes to a routine which uses DocumentExport to create a copied file and save it to a pdf. Then, using ActiveSheet.OLEObjects.add, take this PDF and copy to a specific excel Tab with the "A3" cell being the top/left corner for the file to be placed.
excerpts of my current code:
target = ActiveCell.Task
SaveFilePath = "C:\Macros\"
SaveFileName = SaveFilePath & "Target-" & target & ".pdf"
SaveFilePath = "C:\Macros\"
SaveFileName = SaveFilePath & "Target-" & target & ".pdf"
Application.FilePageSetupView Name:=".MarkedPred_View", allsheetcolumns:=True, BestPageFitTimescale:=True
Application.FilePageSetupPage Name:=".MarkedPred_View", Portrait:=False, PagesTall:=6, PagesWide:=1, PaperSize:=pjPaperLegal, FirstPageNumber:=False
StrHeader = "&18&B" & GetFontFormatCode("Calibri") & "Status Date=" & Format(ActiveProject.StatusDate, "mm/dd/yy") & " Task Name= " & SelTask.Name & " ID:" & SelTask.ID & " UID:" & SelTask.UniqueID
Application.FilePageSetupHeader Name:=".MarkedPred_View", Alignment:=pjCenter, Text:=StrHeader
Application.FilePageSetupLegend Name:=".MarkedPred_View", LegendOn:=pjNoLegend
DocumentExport SaveFileName, pjPDF, FromDate:=EarliestStart - 30, ToDate:=LFin + 30
xlsheet.Range("A3").Select
ActiveSheet.OLEObjects.Add(FileName:=SaveFileName, Link:=True _
, DisplayAsIcon:=False).Activate
If I set the Link property to false, the copy to excel does not happen
sbDeleteAFile (SaveFileName)
Sub DeleteAFile(ByVal FileToDelete As String)
IsFileOpen (FileToDelete)
SetAttr FileToDelete, vbNormal
Kill FileToDelete
End Sub
Function IsFileOpen(FileName As String)
Dim filenum As Integer, errnum As Integer
OutputStr = ("1587 - IsFileOpen - started for = " & FileName) 'added
Call Txt_Append(MyFile, OutputStr)
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open FileName For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
Case 0
IsFileOpen = False
'Open (Filename)
' Error number for "Permission Denied."
' File is already opened by another user.
OutputStr = ("1587 - IsFileOpen - is NOT Open") 'added
Call Txt_Append(MyFile, OutputStr)
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
OutputStr = ("1587 - IsFileOpen - IS Open") 'added
Call Txt_Append(MyFile, OutputStr)
Error errnum
End Select
End Function
"LFin" is the finish date of the target task, from which I am collecting all of its predecessors. I am using the finish date as the "Latest Finish" (LFIN) to bound the "ToDate" in the command.
The error appears with the "ActiveSheet.OLEObjects.Add (fileName:=SaveFilename, Link:=True _" command, where the PDF is opened and copied to the specified excel tab with cell "A3" being the point of the paste for the image.
I do not have any code to close the PDF in this snippet so I get an error when I try to delete an open file. I have seen lots of discussion on various boards where if a file is opened by another application, MS Project VBA cannot delete it as it does not have the handle to the file (??). If I manually close the PDF, close the error notification in the debugger and then press "Run/Continue" , the PDF is deleted and cycles back through the main routine, just like I want it to but I have to again close the newly created PDF, clear the dialog and select Run/Continue.
The only section of this code which does not work as desired (and is currently missing in this code) is having the ability to close the PDF after it has been copied to Excel as it is no longer needed. I have only seen very complicated code which gets the handle of the PDF and then allows you to close the specific file without affecting any other PDF files which may also be open and are not part of this process.
Does anyone have any ideas? I first started using CopyToClipboard, but this command only can copy 16 rows of MS Project schedule to the clipboard. Then, I tried ExportAsFixedFormat, but the FromDate and ToDate entries have no effect on the displayed image.
Using DocumentExport and Application.OLEObjects.Add allows me to copy unlimted pages of schedule to the clipboard and paste into an excel tab showing the desired dates only.This is the closest I have been able to come to get what I want the output to look like. I have been unable to find an associated command to Application.OLEObjects.Add command which I can use to close the PDF file created by the Application.OLEObjects.Add. It certainly makes sense that you want to open the PDF file so it can be copied to the Excel tab, but it is surprising there is not also an easy way to close that PDF file after it has served its purpose.
The question boils down to this:
The error appears with the "ActiveSheet.OLEObjects.Add
(fileName:=SaveFilename, Link:=True, DisplayAsIcon:=False).Activate" command, where the PDF is
opened and copied to the specified excel tab...
The reason the pdf file opens is that the code is telling it to. By using the Activate method on the OLEObject just added, it activates it--meaning in opens the pdf file.
The solution is to simply the OLEObjects.Add method to this:
ActiveSheet.OLEObjects.Add FileName:=SaveFileName
I have a Userform which allows user to transfer item from ListBox1 to ListBox2.
The items in ListBox2 are supposed to be filenames of excel files which are to be imported.
I have an overall idea of how this can operate but I am stuck with the problem that I cannot open the file with the item name in ListBox2.
My question is, is it possible to "convert" the item name in a Listbox to a string so it can be used as the filename for file opening?
I tried to use the MsgBox to test if the Listbox2(i) / ListBox2.Name(i) / ListBox2.List(i) argument returns any values but unfortunately it doesn't. It always shows blank.
'This is the part where I try to open the files indicated in ListBox2
Dim directory = "my directory is here"
For i = 0 To ListBox2.ListCount - 1
Application.Workbooks.Open Filename:= directory & "\" & "FinalExcel.xlsx" 'This one is for testing to open file and it works.
Application.Workbooks.Open Filename:= directory & "\" & ListBox2(i)
Next
As mentioned in the comments, proper way to refer to ListBox items in an array-like fashion is via the ListBox.List(i) route.
Also a good practice would be to to check first whether the ListBox is empty, because attempting to open an empty file (because of non-existent ListBox field) will result in an error!
If Not ListBox2.ListCount = 0 Then
For i = 0 To ListBox2.ListCount - 1
Application.Workbooks.Open Filename:= directory & "\" & ListBox2.List(i)
Next i
End If
I want to create a macro that can check and open file based on filename.
ex:
15.xlsm As opened workbook
12.xlsm As a target
16.xlsm As the future workbook
So while I click a button in 15.xlsm that will open the previous file (12.xlsm). But in future, when the 16.xlsm is created, the 16.xlsm must open the previous workbook (15.xlsm).
I was trying with this code
Sub Macro1()
Dim a, x As Integer
Dim path, filename As String
Dim varday, varyest As Long
varday = Day(Range("A1"))
For x = 1 To 30
varyest = varday - x
filename = "" & varyest & ".xlsm"
path = "F:\Kemal\" & filename & ""
If Dir(path) = "" Then
Else
Workbooks.Open filename:=path
End If
Next x
End Sub
but that code has open all workbook like 12.xlsm, 10.xlsm, 9.xlsm, and create unlimited messagebox. Yeah I know the algorithm but, how to put it into code is the big problem. anyone help me, pls.
So, How to check previous file is exist or not with date that placed on every workbook name?
to know if file exists :
CreateObject("Scripting.FileSystemObject").FileExists(p)
If you want to check MANY files, you may want to use the content of the whole folder and lookup the array.
if target workbooks has a Workbook_Open that's not to be launched:
Application.EnableEvents = False
workbooks.open(file)
Application.EnableEvents = true
Question is a bit fuzzy to me, I hope this answers
In my organization we have an Excel template that all employees have to fill frequently. This template originates hundreds/thousands of Excel files (workbooks) per year.
For the sake of organisation, I urgently need to have a unique ID for each of these files (i.e. unique ID per workbook generated by this template).
Currently, my idea is to generate the following ID in a cell of the workbook:
[user]-[YYYYMMDD]-[hhmmss]
in which:
user is a string representing the username of the employee which would be filled in by the user. So no problem here.
YYYYMMDD is year, month and day
concatenated
hhmmss is hour, minute and second concatenated
For this effect, I would need that my Excel template automatically fills a cell with the YYYYMMDD-hhmmss information with the exact date and time of generation.
This information should be created once the template generates the workbook, and cannot be changed ever after. So these should be values in a (protected) cell and not a formula (I guess).
I cannot figure out how to do this after searching for a long time. I am not sure if it is needed or not, but I am no master of VBA.
The idea of having a date/time field is good .... create a workbook smilar to this
add the following code to the ThisWorkbook module:
Private Sub Workbook_Open()
If [B2] = "" Then
' timestamp
[B2] = Now()
' suppress warning when saving macro containing workbook in non-macro format
Application.DisplayAlerts = False
' save under calculated name
ActiveWorkbook.SaveAs [B1] & "-" & Format([B2], "YYYYMMDD-hhmmss")
' turn on alerts again
Application.DisplayAlerts = True
End If
End Sub
and save as a macro enabled template
Then create a [File - New] from this template .... it will immediately be saved under the name of the user with macros removed so that the code can't hit it another time.
The user name could be retrived from the environment or from the registry.
Alternatively you can examine if the file has a true name or (still) is named Book nnn which means it hasn't been saved before; this removes the need to reserve a timestamp cell in your workbook
Here are a couple of functions you could use to get your id. If you put this inside a vba module on your template you will be able to call the functions from the worksheets or other vba code (e.g. in workbook just enter '=get_id()', in vba you would do something like 'id = get_id()' to call this:
Option Explicit
Public Function lpad(string1, padded_length, _
Optional pad_string = " ")
Dim chars
chars = padded_length - Len(string1)
lpad = WorksheetFunction.Rept(pad_string, chars) & string1
End Function
Public Function get_id()
Dim user
Dim YYYYMMDD
Dim hhmmss
user = Environ("username")
YYYYMMDD = Year(Now()) & lpad(Month(Now()), 2, 0) & lpad(Day(Now()), 2, 0)
hhmmss = lpad(Hour(Now()), 2, 0) & lpad(Minute(Now()), 2, 0) & lpad(Second(Now()), 2, 0)
get_id = user & "-" & YYYYMMDD & "-" & hhmmss
End Function
The lpad function is just for formatting (so that you get 07 for July instead of 7 etc.). I have also added something here to set the user to the windows environment variable for the current user's name, but if you want to promt the user instead this part could easily be replaced.
Let me know if you have any questions.