Znaci nije potrebno da se dodaje u nazivu file-a datum kao sto je primer i kao sto je bilo s' pocetka.
Brzinski sam ti dodao sve okvirno u kodu sta je trazeno u poslednjoj poruci.
Nadam se da je sad to to.
Takodje, sugestija dobronameran je da ubuduce se definise sta se hoce i da se odradi idejno koncept sta se hoce kako bi se to posle pretvorilo u kod.
Sve sto se gore pisano je malo konfuzno i nije bas lepo definisano... (nije zlurado vec opet dobronamerno receno).
Ostavio samo delove koda u komentarima cisto da mozes da vidis razlike i da mozes malo da prostudiras kod posto vidim da se nema bas puno iskustva sa VBA.
Code:
Sub RenameDocumentWithDate()
Dim strDocName, strDocNameNoExten, strDocFullName, strDocPath As String
Dim strNewDocName As String
Dim SaveAsFilename As String
' Get the current doc name
strDocName = ActiveDocument.Name
' Get current full filename
strDocFullName = ActiveDocument.FullName
' Get current filename path only
strDocPath = ActiveDocument.Path
' Get current filename extension - since can be 3 or 4 char. len e.g. filename.doc || filename.docx ...
strDocExt = Right(strDocName, Len(strDocName) - InStrRev(strDocName, "."))
' Old > strDocNameNoExten = Left(strDocName, Len(strDocName) - 5)
' Set current filename without extension
strDocNameNoExten = Left(strDocName, Len(strDocName) - (Len(strDocExt) + 1))
' If Document path isn't set then
If strDocPath = "" Then
' Show messagebox to user
MsgBox ("This document hasn't been saved. You can't rename it.")
Exit Sub
End If
' Pop up an input box for new name.
' Old > strNewDocName = InputBox("Enter a new name for this document:", "Rename document", strDocName)
strNewDocName = InputBox("Enter a new name for this document:", "Rename document", strDocNameNoExten)
' If new filename isn't set then exit
If Len(Trim(strNewDocName)) = 0 Then
' Show messagebox to user
MsgBox ("Name of this document hasn't been set. You can't save it.")
Exit Sub
End If
' If filename is same and already exists
If LCase(strNewDocName) = LCase(strDocNameNoExten) Then
' If current file already exists then
If Dir(strDocFullName) <> "" Then
' Show messagebox to user
MsgBox ("You can't use same name of file for saving." & vbCrLf & "Please try again by entering a diffrent filename.")
Exit Sub
End If
End If
' If backslash isn't present on the end of path then add it
If Right(strDocPath, 1) <> "\" Then strDocPath = strDocPath & "\"
' Create filename with full location where will be saved
SaveAsFilename = strDocPath & strNewDocName
Debug.Print "Document name:", strDocName
Debug.Print "Document name without ext.:", strDocNameNoExten
Debug.Print "Document full name:", strDocFullName
Debug.Print "Document path:", strDocPath
Debug.Print "New document name:", strNewDocName
Debug.Print "Save document as filename:", SaveAsFilename
' Check MS Word version
' Word versions are 15 - 2013, 14 -> 2010, 12 - 2007, 11 - 2003
' If MS Word version is newer then MS Word 2007 then
If Val(Application.Version) > 12 Then
' Old > ActiveDocument.SaveAs2 FileName:=strDocPath & "\" & strDocNameNoExten & " " & strDate
' ActiveDocument.SaveAs2 FileName:=strDocPath & "\" & strNewDocName
' Save current document with new filename
ActiveDocument.SaveAs2 FileName:=SaveAsFilename
' If MS Word version is 2007 or older then
Else
' Old > ActiveDocument.SaveAs FileName:=strDocPath & "\" & strDocNameNoExten & " " & strDate
' ActiveDocument.SaveAs FileName:=strDocPath & "\" & strNewDocName
' Save current document with new filename
ActiveDocument.SaveAs FileName:=SaveAsFilename
End If
On Error Resume Next
' Delete current (original) file
Kill strDocFullName
' If there was any error when deleting a file from given location then
If Err.Number <> 0 Then
' Show message to user
MsgBox "Error in deleting file for given location." & vbCrLf & vbCrLf & "Error " & Err.Number & " - " & Err.Description, vbCritical, "Saving document"
End If
Err.Clear
End Sub