1. Snimanje file-a sa navedenim nazivom 271.18
Problem je sto se parsuje naziv i skida ekstenzija file-a. Posto u nazivu file-a postoji tacka onda uneti naziv file-a postaje 271 a ekstenzija 18. Znaci 271.18 je file sa ekstenzijom 18 gde je onda ime file-a 271 bez 18.
U nastavku je primer kako to moze da se resi. Dodaje se na naziv file-a ekstenzija vec snimljenog file-a i izmedju naziva file-a i ekstenzije file-a tacka.
Takodje su mi potrebne dodatne informacije o privilegijama User koji rad sa tim file-om kao i naziv i lokacija file - vidi dole na kraju predlog oko debug dela.
Primer resenja je (samo ispravljeni red u kodu):
Code:
' Create filename with full location where will be saved
SaveAsFilename = strDocPath & strNewDocName & "." & strDocExt
2. Problem koji se desava prilikom brisanja file-a je sto ili naziv file-a nije dobar ili je losa putanja ili je 'zakljucan' od strane OS ili nema privilegija za brisanje ili su atributi za file takvi da nije moguce obrisati isti.
Takodje ako su veliki fileovi u pitanju, isto proces sniamanja moze da potraje te tako isto i to moze da bude problem - zbog angazovanih resursa (kopira se postojeci file a dok proces jos traje ili jos se nije spustio na disk, pocinje proces brisanja).
S' tim u vezi dodao sam f-ju koja isto sluzi za brisanje file-ova ali koristeci FileSystemObject. Dole u nastavku je ceo kod, koji koristi i poziva tu f-ju. Ostavio sam i stari nacin...
Takodje su mi potrebne dodatne informacije o privilegijama User koji rad sa tim file-om kao i naziv i lokacija file - vidi dole na kraju predlog oko debug dela.
3. Takodje promenjen je redosled u prvom delu koda za deo kada se kreira naziv postojeceg file-a bez ekstenzije, koji je napravljen na osnovu tvog prvobitnog koda. Ta linija sada ispod uslova za proveru putanje kako bi se izbegla greska koja se javlja kada file nije postojeci tj. nije snimljen.
Kompletan kod u nastavku
Code:
' Delete file using FileSystemObject
Private Function DeleteFile(ByVal Filename As String) As Boolean
On Error Resume Next
Dim xFSO As Object
' Create new instance of object
Set xFSO = CreateObject("Scripting.FileSystemObject")
' Return value
DeleteFile = True
' Delete file
xFSO.DeleteFile Filename
If Err.Number <> 0 Then
' Return value
DeleteFile = False
' Show message
MsgBox "Error in deleting file for given location." & vbCrLf & _
"File: " & Filename & vbCrLf & vbCrLf & _
"Error " & Err.Number & " - " & Err.Description, vbCritical, "Saving document"
Debug.Print "Error deleting file for given filename:", Filename
Err.Clear
End If
' Free memory resource
Set xFSO = Nothing
End Function
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)
' 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
' Set current filename without extension
strDocNameNoExten = Left(strDocName, Len(strDocName) - (Len(strDocExt) + 1))
' 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 & "." & strDocExt
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
' Solution 1: Delete file using built in KILL
' 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"
'Err.Clear
'End If
' Solution 2: Delete file using FileSystemObject and internal function call
' Call function to delete original file
DeleteFile strDocFullName
End Sub
Takodje kada se daju informacije o gresci, ne bi bilo lose da se daju i sve vrednosti koje su bile u kodu u momentu pojavljivanja greske.
Na primer deo koji se pojavljuje u DEBUG prozoru tj. IMMEDIATE delu. - U VBA se otvara se sa CTRL + G ili preko menu VIEW pa IMMEDIATE WINDOW.
Evo konkretnog primera odatle:
Code:
Document name: Doc1.docx
Document name without ext.: Doc1
Document full name: C:\Users\VBAUser\Desktop\Doc1.docx
Document path: C:\Users\VBAUser\Desktop\
New document name: 271.18
Save document as filename: C:\Users\VBAUser\Desktop\271.18.docx
Document name: Doc1.docx
Document name without ext.: Doc1
Document full name: E:\Doc1.docx
Document path: E:\
New document name: 271.18
Save document as filename: E:\271.18.docx
p.s. Takodje ako i dalje bude bilo problema oko brisanja file-a nakon snimanja istog pod drugim imenom, onda bi trebalo pokusati sa dodavanjem koda koji bi setovao file atribute pre brisanja i eventualno sinhronizovanog dela - snumanje sadrzaja pa brisanje fiile-a.
[Ovu poruku je menjao bokinet dana 17.08.2018. u 22:23 GMT+1]
