XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal

[arnoldbrice19]

Bonjour les experts,
Je vous expère en bonne santé et vous souhaite un excéllent week-end !

Je viens vers vous car je suis bloqué sur une macro qui doit créer un fichier texte (.text) dans le repertoire où se trouve un classeur encours d'exécution afin d'enregistrer les dates des évènements ".save" de celui-ci. Un fichier (.Zip) est join pour illustrer le travail que j'ai déjà fait. Vous décompresserez mais ne déplacerez pas le fichier (.xlsm).

Le problème se trouve uniquement au niveau des enregistrements dans le fichier journal. Je recommande de cliquer sur le bouton QUITTER dans le classeur à deux ouvertures pour observer. Le MDP est : 0000 mais ça n'empêche pas l'examination de la macro. c'est mot de passe sur la procédure.

Si nécessaire, veuillez activer la référence Windows Script Host Object Model.

S'IL VOUS PLAIT !

En effet, je souhaite que la macro crée un (.text) pour chaque mois et enregistre les évènements que je lui ai indiqués pour les mois concernés : un évènement par ligne dans le fichier journal, et un journal par mois.
Cependant, si vous trouvez cela pénible, je souhaiterais que un seul journal soit créé pour la cause, mais avec la possibilité de définir la limite du nombre de ligne à renseigner. Par exemple, si c'est 10 lignes le maximum, dès que la 10ième ligne est atteinte, les 5 premières s'effacent pour laisser place aux nouveaux enregistrements. Le but étant de ne pas surcharger le journal.

Function CheminJournal() As String
    Dim fso As Object
    Dim mois As String
    Dim annee As String
    Dim journalPath As String
    mois = Format(Date, "MM")
    annee = Format(Date, "YYYY")
    journalPath = ThisWorkbook.Path & "\journaux\" & "journal_" & mois & "_" & annee & ".txt"
    Set fso = Nothing
    CheminJournal = journalPath
End Function

'-----Création du fichier journal------------------------
Sub CreerNouveauJournalMensuel()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CreateTextFile CheminJournal(), True
    Set fso = Nothing
End Sub

Sub Cmd_Quit()
    Dim strPassword As String
    Dim strPrincipal As String
    Dim msg As Variant
    Dim fso As Object
    Dim ts As Object

    ' Enregistrer les modifications du classeur cloné
    ActiveWorkbook.Save
    
        ' Créer un nouveau journal mensuel pour chaque mois si ça n'existe pas dans le repertoire journaux
'    If Day(Date) = 1 Then
'        CreerNouveauJournalMensuel
'    End If

    ' Créer un fichier journal (exemple : dans le même répertoire que le classeur principal)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.CreateTextFile(ThisWorkbook.Path & "\journaux\journal.txt", True)     'Set ts = fso.OpenTextFile(CheminJournal(), True)    ' si CreerNouveauJournalMensuel est exécuté

    If Err.Number <> 0 Then
        MsgBox "Erreur lors de la création du fichier journal : " & Err.Description
    Else
        ' Demander la confirmation à l'utilisateur avant d'écrire dans le journal
        msg = MsgBox("Voulez-vous vraiment écraser le fichier principal ?", vbYesNo + vbQuestion, "Confirmation")
        If msg = vbYes Then
            ' Demande du mot de passe
            strPassword = InputBox("Veuillez entrer le mot de passe administrateur :", "Confirmation")

            If strPassword = "0000" Then
                ' Construire le chemin complet du fichier principal
                strPrincipal = ThisWorkbook.Path & "\Journalisation.xlsm"

                ' Vérifier si le fichier principal existe et s'il est un classeur Excel
                If Dir(strPrincipal) <> "" And InStr(1, strPrincipal, ".xlsm", vbTextCompare) > 0 Then
                    ' Enregistrer les modifications dans le fichier principal
                    ThisWorkbook.SaveAs Filename:=strPrincipal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
                    ts.WriteLine Format(Now, "dd/MM/yyyy HH:mm:ss") & " - Fichier principal mis à jour par " & Environ("Username")
                Else
                    ts.WriteLine Format(Now, "dd/MM/yyyy HH:mm:ss") & " - Fichier principal introuvable ou format incorrect."
                End If
            Else
                ts.WriteLine Format(Now, "dd/MM/yyyy HH:mm:ss") & " - Mot de passe incorrect. Opération annulée."
            End If
        Else
            ' Si l'utilisateur annule, on ne fait rien de plus
            ts.WriteLine Format(Now, "dd/MM/yyyy HH:mm:ss") & " - Opération annulée par l'utilisateur."
        End If

    End If
    
    ts.Close

    On Error GoTo 0
    Set ts = Nothing
    Set fso = Nothing

    ' Fermeture de l'application
    ExitApp = True
    ThisWorkbook.Close SaveChanges:=False
    Application.Quit
End Sub

Je vous remercie, par avance, de votre soutien !

 

[Staple1600]

Bonjour @arnoldbrice19 ,le fil

Un exemple simple (ressorti de mes archives)
Dans un module standard

Sub Log2File(Filename As String)
    Dim f As Integer
    f = FreeFile
    Open Filename For Append Access Write Lock Write As #f
    Print #f, Now
    Close #f
End Sub

Dans ThisWorkbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fich$
fich$ = ThisWorkbook.Path & "\logfile.txt"
Log2File fich
End Sub

PS: test OK sur mon PC (W10/O365)
(Le classeur et le fichier *.txt seront dans le même répertoire)

 

[patricktoulon]

bonjour
juste en passant

tu ,aura toujours les 10 dernier événements

Function CheminJournal() As String
    Dim fso As Object
    Dim mois As String
    Dim annee As String
    Dim journalPath As String
    mois = Format(Date, "MM")
    annee = Format(Date, "YYYY")
    journalPath = ThisWorkbook.Path & "\journaux\" & "journal_" & mois & "_" & annee & ".txt"
    Set fso = Nothing
    CheminJournal = journalPath
End Function

'-----Création du fichier journal------------------------
Sub CreateORappend_Mensuel()
    Dim myfile$, x&, i, txt$
    myfile = CheminJournal
    If Dir(myfile) <> "" Then
        x = FreeFile: Open myfile For Input As x: Lines = Input$(LOF(x), #x): Close #x
        t = Split(Lines, vbCrLf)
        'MsgBox UBound(t)
        If UBound(t) > 10 Then
            For i = UBound(t) - 9 To UBound(t)
                If Trim(t(i)) <> "" Then txt = txt & vbCrLf & Trim(t(i))
              
            Next
        Else
        txt = Mid(Left(Lines, Len(Lines) - 2), 3)
        End If
    
       End If
        x = FreeFile: Open myfile For Output As #x:
  Print #x, txt & IIf(Trim(txt) <> "", vbCrLf, "") & CStr(Now) & " Modifié par : " & Environ("username")
    Close #x
End Sub

 

[job75]

Bonjour arnoldbrice19, JM, Patrick,

Très simplement dans ThisWorkbook :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim chemin$, fichier$, a(), x%, n%
chemin = ThisWorkbook.Path & "\Journaux\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'crée le sous-dossier
fichier = chemin & "Journal_" & Format(Date, "yyyy_mm") & ".txt"
ReDim a(0): a(0) = Now
If Dir(fichier) <> "" Then
    x = FreeFile
    Open fichier For Input As #x
    While Not EOF(x) And n < 9
        n = n + 1
        ReDim Preserve a(n)
        Line Input #x, a(n)
    Wend
    Close #x
End If
x = FreeFile
Open fichier For Output As #x
Print #x, Join(a, vbCrLf)
Close #x
End Sub

Ouvrez et enregistrez le fichier joint puis voyez le fichier créé dans le répertoire "Journaux".

A+

 

[arnoldbrice19]

Bonsoir mes experts,
Mon dimanche était tout particuièrement sécoué, raison pour laquelle j'ai tardé à réagir sur vos commentaires.

Ne m'en sortant pas trop sur les codes, j'ai fait deux jours sur le code sans pour autant trouvé la solution.

Je vous remercie pour vos différentes réactions JM, Patrick et Job. Je remercie tout particulièrement Patrick et Job pour le résultant satisfaisant, après avoir tester vos améliorations. Vous m'avez enlevé une grosse tracasserie dans la tête.

Bonne soirée à vous !

A bientôt.