View Full Version : poping up a message box and opening another file
olhey
04-25-2018, 12:03 AM
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
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
gmayor
04-25-2018, 02:14 AM
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.
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
olhey
04-25-2018, 05:12 AM
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
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
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
gmayor
04-25-2018, 10:56 PM
OK then from Word you would need
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
olhey
04-26-2018, 05:54 AM
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
With Word 2016 I found that a change was necessary
Set X.App = Word.Application should be
Set X.appWord = Word.Application
gmayor
04-26-2018, 06:42 AM
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
Private Sub Document_Open()
Set App = Word.Application
End Sub
Paul_Hossler
04-26-2018, 09:39 AM
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
olhey
04-30-2018, 02:54 AM
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 ???)
Paul_Hossler
04-30-2018, 10:49 AM
abut PPT: the macro for word should also work for ppt? (changing thisdocument. to ???)
Probably
ActivePresentation
olhey
05-01-2018, 12:34 AM
in PPT,
in class module called classSAVE:
Public WithEvents PPTEvent As Application
in standard module
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.
olhey
05-07-2018, 02:49 AM
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...:(
olhey
05-08-2018, 08:19 AM
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
Public WithEvents PPTEvent As Application
Private Sub PPTEvent_PresentationBeforeSave(ByVal Pres As Presentation, Cancel As Boolean)
...MY code.
end sub
a standard module
Dim oEH As New classSAVE
Sub InitialiseApp()
Set oEH.PPTEvent = Application
End Sub
I used this method (www.pptalchemy.co.uk/PowerPoint_Auto_Open_Code.html) to auto fire the initialiseApp part of PPT macro.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.