Private Declare Function GetUserName Lib 'advapi32.dll' Alias 'GetUserNameA' _
(ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim iMsg As Object, iConf As Object
Dim strHTML As String, UserName As String
Dim lpBuff As String * 25
Dim retVal As Long
If ThisWorkbook.Saved = False Then
retVal = GetUserName(lpBuff, 25)
'source 'Spy Opening/Closing @Thierry
UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
strHTML = ''
strHTML = strHTML & '<HEAD>'
strHTML = strHTML & '<BODY>'
strHTML = strHTML & '<b> Fichier : </b>' & ThisWorkbook.FullName & '</br>'
strHTML = strHTML & '<b> Modifié le : </b>' & Now & '</br>'
strHTML = strHTML & '<b> Par : </b>' & UserName & '</br>'
strHTML = strHTML & '</BODY>'
strHTML = strHTML & ''
Set iMsg = CreateObject('CDO.Message')
Set iConf = CreateObject('CDO.Configuration')
With iMsg
Set .Configuration = iConf
.To = 'michelxld@yahoo.fr'
.Subject = 'info modification classeur '
.HTMLBody = strHTML
.Send
End With
End If
End Sub
