I've tested the whole code, it works pretty good unless the user choose a name with "." , then it creates a file with no excel extention ".xlms". (like: new name 2.4.21 - that's it without .xlms)
Is it possible to change the code that instead of asking the user for a name, the code will choose a name automatically , and the name will be "new name"+Today date ? that will be seriously awesome.
for example executing the code today will give a name of:
New Name 3.5.21
and tomorrow will be
New Name 4.5.21
and so on .
just wondering if that possible with fixing the problem that the code doesn't give excel extension when a "." involved in the name.
it makes the whole code bitter sweet .
thank you already for all the help .
Netanel
Code
Option Explicit
Private Sub CommandButton1_Click()
Dim wbNew As Workbook
Dim sPath As String, sFil As String, sLastFil As String
Dim dLastDate As Date, sLastModified As Date
Dim iCnt As Integer
Dim ans As Variant
''///change the file path
sPath = ThisWorkbook.Path & Application.PathSeparator & "library"
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFil = Dir(sPath & "*.xls*", vbNormal)
If Len(sFil) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
Do While Len(sFil) > 0 And sFil <> ThisWorkbook.Name
sLastModified = FileDateTime(sPath & sFil)
If sLastModified > dLastDate Then
sLastFil = sFil
dLastDate = sLastModified
End If
sFil = Dir
Loop
prompt_again:
iCnt = iCnt + 1
If iCnt < 3 Then
ans = InputBox("Please Enter a name for the new workbook", "Enter Name")
If Len(ans) = 0 Then GoTo prompt_again
Else: Exit Sub
End If
Application.ScreenUpdating = False
Set wbNew = Workbooks.Open(sPath & sLastFil)
wbNew.SaveAs sPath & ans, 52 ''///51 = xlsx 52= xlms
wbNew.Close False
With ThisWorkbook.Sheets("Products & Services Contents").Range("B" & Rows.Count).End(xlUp).Offset(1)
.Value = ans
ActiveSheet.Hyperlinks.Add _
Anchor:=.Offset(, -1), _
Address:=(sPath & ans & ".xlsm"), _
TextToDisplay:="Link"
Workbooks.Open sPath & ans
End With
End Sub
Display More