poping up a message box and opening another file

Dear all,

I'm trying to force users of certain files to keep a logbook updated. So when they try to save those files a message box appears and asks if they need to update the log book:

if yes Open the logbook files
if no save the current file.

It works very well for excel files but not for word files (i'll will also do it for PPT). The final idea is to insert this code in template for each file format.

I already thank you for your help

Code:

---

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim Confirm As VbMsgBoxResult

Application.EnableEvents = False

Cancel = True

Confirm = MsgBox("Do you need to updtate de log book?", vbYesNo)

If Confirm = vbYes Then
Workbooks.Open ("C:\Users\Vincent\Desktop\test1.xlsx")

Else

ThisDocument.Save

End If
Application.EnableEvents = True

End Sub

---

Your code is Excel code and not Word (or PowerPoint) code so it is not going to work as you have it. You could use Word events to prompt before save by putting the following in the ThisDocument module of your template. Creating a new document from the template initialises the event and when you save the document you get a prompt.

In order to use your Excel log you would either have to then start Excel open the log, write the data, save the log and close it - or better still use SQL to write to the workbook, but we would need to know more about your workbook before that's a possibility.

Code:

---

Option Explicit
Private WithEvents App As Word.Application

Private Sub Document_Open()
    Set App = Word.Application
End Sub

Private Sub Document_New()
    Set App = Word.Application
End Sub

Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
    MsgBox ("BeforeSave")
    'your Excel access goes here
End Sub

---

Thx Gmayor for your answer.

I added few lines to my code, so when the log file is open the file fullname, the user name , and the date are automatically filled, the user just need to add a description of the modification.
base on that the simplest way i think would be the

Quote:

---

start Excel open the log, write the data, save the log and close it

---

excel file is simply a 4 columns sheet with file fullname(of the monitored file), the user name , the date , and modification description

Code:

---

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim Confirm As VbMsgBoxResult

Application.EnableEvents = False

Cancel = True

Confirm = MsgBox("Do you need to updtate de log book?", vbYesNo)

If Confirm = vbYes Then

    Set monitoredDoc = ThisWorkbook
   
    Set historyWb = Workbooks.Open("C:\Users\Vincent\Desktop\Excel-Malin\test1.xlsx")
    Set historyWks = historyWb.Worksheets(1)

    Dim chemin As String

    chemin = monitoredDoc.FullName

        With historyWks
            nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
        End With
        With historyWks
            With .Cells(nextRow, "C")
                        .Value = Now
                        .NumberFormat = "mm/dd/yyyy hh:mm:ss"
            End With
            .Cells(nextRow, "B").Value = Application.UserName
            .Cells(nextRow, "A").Value = chemin

        End With


    Else

    ThisWorkbook.Save

End If

Application.EnableEvents = True

End Sub

---

OK then from Word you would need

Code:

---

Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
Dim strWB As String
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim strUser As String
Dim vUser As Variant
Dim dDate As Date
Dim dTime As Date
Dim bStarted As Boolean
Dim NextRow As Integer
Dim fso As Object
    strWB = Environ("USERPROFILE") & "\Desktop\Excel-Malin\Test1.xlsx"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(strWB) = False Then
        MsgBox "Workbook log " & vbCr & strwb & vbCr & "is missing!"
        GoTo lbl_Exit
    End If

    vUser = Split(Environ("USERPROFILE"), "\")
    dDate = Date
    dTime = Time
    strUser = vUser(UBound(vUser))
    MsgBox "BeforeSave"
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
        bStarted = True
    End If
    On Error GoTo 0

    Set xlBook = xlApp.Workbooks.Open(FileName:=strWB)
    xlApp.Visible = True
    Set xlSheet = xlBook.Sheets(1)

    With xlSheet
        NextRow = .Range("A" & .Rows.Count).End(-4162).Row + 1
        .Cells(NextRow, "C").Value = dDate & Chr(32) & dTime
        .Cells(NextRow, "B").Value = strUser
        .Cells(NextRow, "A").Value = ThisDocument.FullName
    End With
    xlBook.Save

    If bStarted Then xlApp.Quit
    Set xlApp = Nothing
lbl_Exit:
    Set fso = Nothing
    Exit Sub
End Sub

---

Thank you gmayor,

good thing to add and error management, but unexpectedly the script (put in "this document" part of visualbasic) is not launched when hitting ctrl+s (save) !?

I was working on it since this morning and still nothing interesting discovered...

EDIT :looking on the www it looks like it comes from the fact that I have no clue how different module types work...
EDIT 2: thanx to https://stackoverflow.com/a/40673321/9704680 it is working

Code:

---

With Word 2016 I found that a change was necessary

 

       

Code:

       

---

Set X.App = Word.Application

---

  should be
 

       

Code:

       

---

Set X.appWord = Word.Application

---

---

It does work when you click CTRL+S, but you need the part of the macro (below) to setup the Event and that runs when you next open the document, or if you run the macro manually

Code:

---

Private Sub Document_Open()
Set App = Word.Application
End Sub

---

If it were me, I wouldn't trust my users to have access to the master log file

In Excel, PPT, and Word Open events, I'd write write identifying information, date/time, etc. to a CSV file on a server (open, write, close)

In Excel, PPT, and Word Close events, I'd have a userform displayed with a textbox for them to add a description of their changes, and then write identifying information, date/time, and description to a CSV file, no matter how they closed the user form

Since the CSV writting can be done with VBA, there'd be no need to open an Excel instance, and no significant chance of two people trying to use the XLSX at the same time

Of course, if the clever buggers disable macros, you really can't do anything

For analysis and reporting, it's easy enough to have Excel open the CSV file

Thnx Gmayor, I finally figured it out myself. Thx also Paul_hossler, I totally agree with you, but It is for a small amount of users (~2), so I'll try to trust the users. But that definitely something I'd be interested to investigate more, seems a clever way of doing what I want.

abut PPT: the macro for word should also work for ppt? (changing thisdocument. to ???)

Quote:

---

abut PPT: the macro for word should also work for ppt? (changing thisdocument. to ???)

---

Probably

Code:

---

ActivePresentation

---

in PPT,

in class module called classSAVE:

Code:

---

Public WithEvents PPTEvent  As Application

---

in standard module

Code:

---

ublic objSaveSlide As New classSAVE

Private Sub Presentation_Open()
    Set objSaveSlide.PPTEvent = Application
End Sub

Private Sub Preentation_New()
    Set objSaveSlide.PPTEvent = Application
End Sub


Private Sub PPTevent_PresentationBeforeSave(ByVal Pres As Presentation, Cancel As Boolean)

Dim strWB As String
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim strUser As String
Dim vUser As Variant
Dim dDate As Date
Dim dTime As Date
Dim bStarted As Boolean
Dim NextRow As Integer
Dim fso As Object
Dim intResponse As Integer
 
 
    intResponse = MsgBox("update the logbook", vbYesNo)
[...then same code with small modification]

---

The message box isn't even firing...

I cant find find (even in microsoft help) a clear explanation of how event on action works... That could be very useful to master for future projects.

Hi all,

I've still not figured out how to make it works on PPT. The macro is not firing on event. I'm struggling right now since I've got not a lot of time to spend on this project...:(

I'v found my mistake. I didn't initialize the event handler, that's why it was not firing.

So now it is working I have:

a class module
with

Code:

---

Public WithEvents PPTEvent  As Application
Private Sub PPTEvent_PresentationBeforeSave(ByVal Pres As Presentation, Cancel As Boolean)

...MY code.

end sub

---

a standard module

Code:

---



Dim oEH As New classSAVE

Sub InitialiseApp()
  Set oEH.PPTEvent = Application
End Sub

---

I used this method (http://www.pptalchemy.co.uk/PowerPoi...Open_Code.html) to auto fire the initialiseApp part of PPT macro.