Hello everybody,
in this macro in thisworkbook
inserts a log.txt file into an external folder who modifies or accesses the workbook
it is possible that instead of the txt file it is in xlsx format?
I hope I have explained. Thanks in advance
in this macro in thisworkbook
VBA Code:
Option Explicit
Dim modificato As Boolean
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
modificato = True
End Sub
'================================================================
'================================================================
Private Sub Workbook_Open()
Dim fogli As Worksheet
Dim Ur As Long
'-----------------------------------------------------------------------
'per username - chi apre
Sheets("Utenti_Errori").Unprotect "987654"
Sheets("Utenti_Errori").Cells(2, 6).Value = Environ("UserName") 'F2
Sheets("Utenti_Errori").Protect "987654"
'------------------------------------------------------------------------
'---------------------------------------------------------------------
'per utilizzare i filtri automatici in fogli protetti
Foglio1.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
Foglio1.EnableAutoFilter = True
Foglio2.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
Foglio2.EnableAutoFilter = True
Foglio3.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
Foglio3.EnableAutoFilter = True
Foglio4.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
Foglio4.EnableAutoFilter = True
Foglio5.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
Foglio5.EnableAutoFilter = True
Foglio11.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
Foglio11.EnableAutoFilter = True
'---------------------------------------------------------------------
'---------------------------------------------------------------------------
'ACCESSI
Dim CurFolder, DestFolder As String
Dim name1 As String
Dim Urec As String
'Dim accessi As String
'name1 = Foglio6.Range("G2").Value
Application.ScreenUpdating = False
'name1 = Foglio2.Range("Z1").Value
name1 = "accessi a " & Foglio11.Range("A2").Value
CurFolder = ActiveWorkbook.Path
DestFolder = CurFolder & "\" & name1 & "\"
If Dir(DestFolder, vbDirectory) = "" Then MkDir DestFolder
Open DestFolder & "\accessi.log" For Append As #1
Print #1, Application.UserName, Format(Now, "dd-mmm-yyyy hh:mm:ss") & " ACCESSO"
'Print #1, Application.UserName, Now & " ACCESSO"
Close #1
Application.ScreenUpdating = True
'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
Sheets("Input").Activate '<<< per aprire direttamente in Input
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim name1 As String, name2 As String, name3 As String, name4 As String, name5 As String
Dim sPath As String, sComm5 As String, sComm6 As String, sComm7 As String, sComm8 As String
Dim fogli As Worksheet
Dim iUserResponse As Integer
Dim risposta1 As String
Dim risposta2 As String
Dim risposta3 As String
Dim sStatus As String
Dim val1 As String
Dim val2 As String
Dim val3 As String
Dim CurFolder As String
Dim DestFolder As String
Dim risposta As String
Dim Urec As String
'------------------------------------------------------------------------------------------------------
'per utente autorizzato
Dim avviso As String
Dim cercarange As Range
Set cercarange = Foglio8.Range("E2:E11").Find(Foglio8.Range("F2"))
If cercarange Is Nothing Then
' MsgBox "Value not found"
avviso = MsgBox(Environ("UserName") & " non sei autorizzato a modificare questo workbook", vbCritical + vbDefaultButton2, "AVVISO!")
If avviso = vbOK Then
'-----------------------------------------------------------------
'ACCESSI/UTENTE AUTORIZZATO
'Dim CurFolder, DestFolder As String
'Dim name1 As String
'Dim Urec As String
'Dim accessi As String
'name1 = Foglio6.Range("G2").Value
'name1 = "accessi"
name1 = "accessi a " & Foglio11.Range("A2").Value
CurFolder = ActiveWorkbook.Path
DestFolder = CurFolder & "\" & name1 & "\"
If Dir(DestFolder, vbDirectory) = "" Then MkDir DestFolder
Open DestFolder & "\accessi.log" For Append As #1
Urec = Cells(Rows.Count, 1).End(xlUp).Row + 1
'Print #1, Application.UserName, Now & " CHIUSURA non modificato" '& ciao
Print #1, Application.UserName, Format(Now, "dd-mmm-yyyy hh:mm:ss") & " CHIUSURA non modificato"
Print #1, "----------------------------------------------------------------------"
Close #1
'----------------------------------------------------------------------
Me.Saved = True
Exit Sub
' MsgBox "Value not found"
'ThisWorkbook.Saved = True
' ThisWorkbook.Close
Else
'MsgBox foundRng.Address
End If
End If
'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
'------------------------------------------------------------------------------------------
'backup
name5 = Foglio11.Range("A2").Value
sComm5 = "BACKUP"
sComm6 = Foglio11.Range("A2").Value
sComm7 = sComm6 'Foglio6.Range("B3").Value
sComm8 = sComm5 & " - " & sComm6 'Foglio6.Range("B3").Value
If MsgBox("Sign. " & Environ("UserName") & " vuoi il backup di:" & Chr(13) & Chr(13) & _
"< " & sComm6 & " >?", vbQuestion + vbYesNo + vbDefaultButton2, "AVVISO!") = vbYes Then
sPath = ThisWorkbook.Path & "\" & sComm8
If Dir(sPath, vbDirectory) = "" Then MkDir sPath
'sPath = sPath & "\" & sComm7
'If Dir(sPath, vbDirectory) = "" Then MkDir sPath
'sPath = sPath & "\" & sComm6
'If Dir(sPath, vbDirectory) = "" Then MkDir sPath
ThisWorkbook.SaveCopyAs sPath & "\" & Format(Now, "dd-mm-yyyy - hh.mm") & " - " & ActiveWorkbook.Name '<<< data/ora
End If
' End If
'--------------------------------------------------------------------------
'-------------------------------------------------------------------------- '
'--------------------------------------------------------------------------
'---------------------------------------------------------------------------
'ACCESSI/FINE SESSIONE
'Dim name1 As String, name2 As String 'modificata
'Dim CurFolder As String
'Dim DestFolder As String
'Dim risposta As String
Application.DisplayAlerts = False
'name1 = Foglio2.Range("Z1").Value
'name2 = Foglio2.Range("Z3").Value
name1 = "accessi a " & Foglio11.Range("A2").Value
CurFolder = ActiveWorkbook.Path
DestFolder = CurFolder & "\" & name1 & "\"
If Dir(DestFolder, vbDirectory) = "" Then MkDir DestFolder
Open DestFolder & "\accessi.log" For Append As #1
If modificato = True Then
risposta = MsgBox("Salvare le modifiche apportate a '" & name1 & "' ?", vbExclamation + vbYesNoCancel, "Microsoft Office Question")
Select Case risposta
Case Is = vbYes
'file modificato e salvato
'Print #1, Application.UserName, Now & " CHIUSURA" & " modificato "
Print #1, Application.UserName, Format(Now, "dd-mmm-yyyy hh:mm:ss") & " CHIUSURA" & " modificato "
ThisWorkbook.Save
Case Is = vbNo
'file modificato ma non salvato
'Print #1, Application.UserName, Now & " CHIUSURA" & " non modificato "
Print #1, Application.UserName, Format(Now, "dd-mmm-yyyy hh:mm:ss") & " CHIUSURA" & " non modificato "
ThisWorkbook.Saved = True
Case Is = vbCancel
'uscita annullata
Cancel = True 'annullo l'evento Close
Close #1 'chiudo il file accessi.log
Exit Sub 'abbandono la macro
End Select
Else
'file non modificato
'Print #1, Application.UserName, Now & " CHIUSURA" & " non modificato "
Print #1, Application.UserName, Format(Now, "dd-mmm-yyyy hh:mm:ss") & " CHIUSURA" & " non modificato "
End If
Print #1, "----------------------------------------------------------------------"
Close #1
'Application.EnableEvents = False 'disabiliti il controllo degli eventi
'ActiveWorkbook.Close False '<<< aggiunta
'Application.EnableEvents = True 'riabiliti il controllo degli eventi
Cancel = True
CloseNoSave
'------------------------------------------------------------------------------------------------------
End Sub
Private Sub CloseNoSave()
Application.EnableEvents = False
ThisWorkbook.Close SaveChanges:=False
Application.EnableEvents = True
End Subinserts a log.txt file into an external folder who modifies or accesses the workbook
it is possible that instead of the txt file it is in xlsx format?
I hope I have explained. Thanks in advance
