Word file expiration date

Visor · #1 10-02-2019, 04:38 AM

Dear friends of the forum, on this occasion I am interested in having a file automatically deleted after a certain date.

I have the following code to be analyzed, I brought it from an excel file in which it works correctly.
Of course, the person who realizes it will be able to avoid this effect, but not for the one who does not know, ..
I would like to ask you to help me review it and suggest the corrections.
This is the code:

HTML Code:

Sub Document_Open()

Dim FechaCaducidad As Date
FechaCaducidad = #4/5/2020#
    If FechaCaducidad > Date Then
 
  'Mensaje de bienvenida
MsgBox ("Bienvenid@" + Chr(13) + Chr(10) & "LE SALUDA SU PROFESOR FELIX FALCONI" + Chr(13) + Chr(10))
    
    Else
        MsgBox "Este archivo dejo de funcionar" & vbCrLf & "Finalizó el período de utilizacion", vbCritical
            Application.DisplayAlerts = False
            ActiveDocument.ChangeFileAccess xlReadOnly
            Kill ActiveDocument.FullName
            ActiveDocument.Close
    End If
End sub

Thanks in advance

gmayor · #2 10-02-2019, 05:10 AM

Your biggest problem here is that you cannot force users to run your macro and Windows security will conspire against you running that macro by warning users not to run it, however given that, the following macro would delete the content of the document, clear the undo stack and save the document without creating a backup.

Code:

Option Explicit

Sub Document_Open()

Dim FechaCaducidad As Date
Dim bBackup As Boolean
    FechaCaducidad = #4/5/2020#
    If FechaCaducidad > Date Then
        'Mensaje de bienvenida
        MsgBox ("Bienvenid@" + Chr(13) + Chr(10) & "LE SALUDA SU PROFESOR FELIX FALCONI" + Chr(13) + Chr(10))

    Else
        MsgBox "Este archivo dejo de funcionar" & vbCrLf & "Finalizó el período de utilizacion", vbCritical
        Application.DisplayAlerts = False
        DeleteAll
        ActiveDocument.UndoClear
        ActiveDocument.SaveAs ActiveDocument.FullName
    End If
End Sub

Sub DeleteAll()
Dim oStory As Range
    For Each oStory In ActiveDocument.StoryRanges
        If oStory.StoryType = wdMainTextStory Then
            oStory.Text = "Este archivo dejo de funcionar" & vbCrLf & "Finalizó el período de utilizacion"
            oStory.Font.Size = 30
        Else
            oStory.Text = ""
        End If
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                oStory.Text = ""
            Wend
        End If
    Next oStory
    Set oStory = Nothing
lbl_Exit:
    Exit Sub
End Sub

Visor · #3 10-03-2019, 08:35 AM

Excellent!! Works!!
Although I would like to know if it is possible for the file to be deleted ... because the vba code would still be there in the macro

Visor · #4 10-02-2019, 07:02 AM

Thanks for the macro sent (Sub DeleteAll ()), In the macro you specify when the execution should occur, ... (later date (expiration))
That's why I placed # 4/5/2020 #
that especially the file will be completely deleted.

It can be applied when I send a Demo file
In Excel I have achieved that but not in Word
Thank you I will try it now

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Checking file date and replacing file if date changes	rdross51	Word VBA	0	07-07-2017 02:32 AM
Making product labels with auto calculated expiration date	adrianppa	Word	2	04-07-2017 12:46 AM
My file dates are wrong, can I use the date inside Word?	Jesperben	Word	2	07-16-2016 03:49 AM
How can a document have the same date modified/create date, yes have have actual file content?	legaleagle	Word	15	01-07-2015 06:58 PM
Conditional Formatting Expiration Dates Based on Text in Adjacent Cell	Frogggg	Excel	1	10-25-2011 08:44 PM