Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 49d71021f2631626…

MALICIOUS

Office (OLE)

440.5 KB Created: 2017-09-25 11:29:00 Authoring application: Microsoft Office Word First seen: 2019-04-18
MD5: 977a6c5413592a96dedeaa0c4242167e SHA-1: 4fd2ef7d06a752994816c06ce8a5bad2854561a9 SHA-256: 49d71021f26316269e79d4e0f7be8145e9cc2d0b4f7b9c66fef82d42a1bf6853
150 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1566.001 Spearphishing Attachment

The sample is a malicious Word document containing VBA macros. The AutoOpen macro and ShellExecute API reference indicate that the document is designed to execute malicious code upon opening. The document body contains a form for an application to an NP-center, which is likely a lure to collect personal information. The ClamAV detection name 'Doc.Dropper.Agent-6609019-0' further supports its malicious nature as a dropper.

Heuristics 6

  • ClamAV: Doc.Dropper.Agent-6609019-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Dropper.Agent-6609019-0
  • Reference to ShellExecute API high SC_STR_SHELLEXEC
    Reference to ShellExecute API
  • Legacy WordBasic auto-exec macro marker medium OLE_LEGACY_WORDBASIC_AUTOEXEC
    OLE Word document contains a legacy WordBasic auto-execution marker such as AutoOpen, but no modern VBA project was recovered and no stronger macro-virus family marker was present. This is analyst-facing evidence for old Word macro execution surface, not a downloader or parser-CVE attribution by itself.
  • VBA macros detected medium 1 related finding OLE_VBA_MACROS
    Document contains VBA macro code
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    Sub AutoOpen()
    Dim oError As ErrorObject
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://ns.adobe.com/xap/1.0/ In document text (OLE body)
    • http://www.w3.org/1999/02/22-rdf-syntax-ns#In document text (OLE body)
    • http://purl.org/dc/elements/1.1/In document text (OLE body)
    • http://ns.adobe.com/xap/1.0/mm/In document text (OLE body)
    • http://ns.adobe.com/xap/1.0/sType/ResourceRef#In document text (OLE body)
    • http://ns.adobe.com/photoshop/1.0/In document text (OLE body)
    • http://ns.adobe.com/tiff/1.0/In document text (OLE body)
    • http://ns.adobe.com/exif/1.0/In document text (OLE body)
    • http://schemas.openxmlformats.org/drawingml/2006/mainIn document text (OLE body)
    • http://schemas.openxmlformats.org/officeDocument/2006/bibliographyIn document text (OLE body)
    • http://schemas.openxmlformats.org/officeDocument/2006/customXmlIn document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 116894 bytes
SHA-256: f7f477e94f73a63aa565baa3aa08cecbf73e664f67c257ba185125fce43ccb4a
Preview script
First 1,000 lines of the extracted script
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




Attribute VB_Name = "ErrorObject"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

'**************************************************
'
'
'   Project:        Form Construction
'   Customer:
'   ClassModule:    ErrorObject
'
'   Created:        01-06-18    Lars-Eric Gisslén
'
'
'   Description:    Error class holding error information
'

'**************************************
'* Win API Declaration
'**************************************

Private Declare Function ShellExec Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal Operation As String, ByVal File As String, _
    ByVal Parameters As String, ByVal Directory As String, ByVal ShowCmd As Long) As Long
    
'**************************************
'* Constants for referensing array
'* elements with error strings
'**************************************
Private Const VBE_CAPTION = 0
Private Const VBE_ERRNUM = 1
Private Const VBE_REASON = 2
Private Const VBE_SOURCE = 3
Private Const VBE_SENDMAIL = 4
Private Const VBE_SITUATION = 5
Private Const VBE_ELEMENTS = 5

Option Explicit

'**************************************
'* Class variables
'**************************************
Private sDescription As String  ' String describing the ErrorNumber
Private nErrorNumber As Long    ' Error number
Private sSituation As String    ' Situation under which the error occured
Private sMacroName  As String   ' Name of the Macro in which the error occured
Private sCaption   As String    ' Caption of the MsgBox
Private sExtra As String        ' Extra info.
Private bSendMail As Boolean    ' Enable sending support mail with error info
Private sCaptions() As String   ' Language specific strings
Private nLangID As Long         ' Numeric language setting in Windows

Public Property Get ErrorNumber() As Long
        ' Retrieve the error number of the Error
    ErrorNumber = nErrorNumber
End Property

Public Property Get Description() As String
        ' Retrieving description corresponding to the ErrorNumber
    Description = sDescription
End Property

Public Sub SetError(ByVal ErrNum As Long)
        ' Assign the Error Number and find the corresponding description
        ' This is for user defined errors like unable to instanciate an ActiveX Server
        ' Using this Sub requires that errors are defined and corresponding error strings
        ' are defined
    nErrorNumber = ErrNum
    SetErrorDescription
    
End Sub

Public Property Let SendMail(bSend As Boolean)
        'Enable/Disable sending error reports via support mail
    bSendMail = bSend
End Property

Public Property Let Situation(ByVal Text As String)
        ' The situation under which the error occured
    sSituation = Text
    
End Property

Property Let MacroName(sName As String)
        ' Set the name of the macro in which the error occured
    sMacroName = sName
    
End Property

Public Property Get Situation() As String
        ' The situation under which the error occured
    Situation = sSituation
    
End Property

Public Property Let Extra(ByVal Text As String)
        ' Extra info, like makro name or other useful info
    sExtra = Text
    
End Property

Public Property Get Extra() As String
        ' Extra info, like makro name or other useful info
    Extra = sExtra
    
End Property

Property Let Caption(DialogCaption As String)
        ' Sets a caption for the MessageBox
        
    sCaption = DialogCaption
    
End Property

Public Sub UseVBErrObject()
        ' Get the error information from the VBA Err Object
        
    nErrorNumber = Err.Number
    sDescription = Err.Description

    
End Sub

Sub Show()
    Dim sMsg As String      ' String to display in the error dialog
    Dim sEmailMsg As String ' Error text to send in email
    Dim sError As String    ' Error number including caption
    Dim sDesc As String     ' Error description including caption
    Dim sMacro As String    ' Macro name including caption
    Dim nReply As Long      ' Response from dialog if email is enabled
    
        ' Set a default dialog caption if missing
    If sCaption = "" Then sCaption = sCaptions(VBE_CAPTION)
    
        ' Build the error strings
    sError = sCaptions(VBE_ERRNUM) + Str(nErrorNumber)
    sMsg = sError + vbCrLf
    sDesc = sCaptions(VBE_REASON) + sDescription
    sMsg = sMsg + sDesc + vbCrLf
    If sMacroName <> "" Then
        sMacro = sCaptions(VBE_SOURCE) + sMacroName
        sMsg = sMsg + sMacro + vbCrLf
    End If
    If sSituation <> "" Then
        sMsg = sMsg + sCaptions(VBE_SITUATION) + sSituation + vbCrLf
    End If
    If sExtra <> "" Then
        sMsg = sMsg + vbCrLf + sExtra + vbCrLf
    End If
        
            ' Check if email is enabled and that the OS is Windows
            ' Sending email will not work on Mac as a WinAPI call is involved
    If (bSendMail = True) And (InStr(LCase(System.OperatingSystem), "win")) Then
        sMsg = sMsg + vbCrLf + sCaptions(VBE_SENDMAIL) ' Text to display in dialog
        nReply = MsgBox(sMsg, vbCritical + vbYesNo, sCaption)
        If nReply = vbYes Then
                ' Build the error info string to send in email
            sEmailMsg = "<<" + sError + ">> <<" + sDesc + ">> <<" + sMacro + _
                        ">> <<" + sSituation + ">> <<" + sExtra + ">>"
            SendSupportMail sEmailMsg
        End If
    Else
            ' No email, just display the error info
        MsgBox sMsg, vbCritical, sCaption
    End If
    
End Sub
Private Sub SendSupportMail(sErrMsg As String)
        ' Send the error information by email
    Dim sBody As String
    Dim sMailTo As String
    Dim nResult As Long
    
    sMailTo = ""
    
        ' Assamble information about the OS and Word version
    sBody = "//***Document***//  "
    sBody = sBody + "<< Title: " + ActiveDocument.BuiltInDocumentProperties("Title").Value + ">>  "
    sBody = sBody + "<< Subject: " + ActiveDocument.BuiltInDocumentProperties("Subject").Value + ">>  "
    sBody = sBody + "<< KeyWords: " + ActiveDocument.BuiltInDocumentProperties("Keywords").Value + ">>  "
    sBody = sBody + "//***Error***// "
    sBody = sBody + sErrMsg
    sBody = sBody + "//***MS Word***//  "
    sBody = sBody + "<< Version: " + Application.Version + ">>  "
    sBody = sBody + "//***Windows***//  " + vbCrLf
    sBody = sBody + "<< OS: " + System.OperatingSystem + ", " + System.Version + ">>  "
    sBody = sBody + "<< Country setting: " + System.LanguageDesignation + ">>  "
    
    

        ' Call WinAPI which in turn will call the default mail application
    
    nResult = ShellExec(0, "open", sMailTo + "?Subject=Macro error&Body=" + sBody, "", "", 0)
    
    If nResult <= 32 Then
        If nLangID = wdSweden Then
            MsgBox "Kunde inte starta standardprogrammet för epost.", vbCritical, "Skicka epost"
        Else
            MsgBox "Unable to call default mail application.", vbCritical, "Send Email"
        End If
    End If

End Sub

Private Sub SetErrorDescription()
        ' Set error message corresponding to error number
        ' Has to be implemented and numeric constants has to be declared
        
End Sub

Function FindCustomDocProperty(sKey As String) As Boolean
        ' Find a custom doc property to avoid runtime error if the property doesn't exist.
    Dim oCustProp As DocumentProperty
    
    FindCustomDocProperty = False
    
    For Each oCustProp In ActiveDocument.CustomDocumentProperties
        If oCustProp.Name = sKey Then
            FindCustomDocProperty = True
            Exit For
        End If
    Next
    
End Function
Private Sub Class_Initialize()
        ' Set defaults on initialization
    Dim sCustProp As String
    ReDim sCaptions(VBE_ELEMENTS)
    
    nLangID = System.Country
    
    If nLangID = wdSweden Then
            ' Set captions to Swedish
        sCaptions(VBE_CAPTION) = "Programfel i makro"
        sCaptions(VBE_ERRNUM) = "Fel nummer "
        sCaptions(VBE_REASON) = "Orsak: "
        sCaptions(VBE_SOURCE) = "Källa: "
        sCaptions(VBE_SITUATION) = "Situation: "
        sCaptions(VBE_SENDMAIL) = "Vill du skicka felmeddelandet som epost till support?"
    Else
            ' Other language, set captions to English
        sCaptions(VBE_CAPTION) = "Runtime Error in Macro"
        sCaptions(VBE_ERRNUM) = "Error number "
        sCaptions(VBE_REASON) = "Reason: "
        sCaptions(VBE_SOURCE) = "Source: "
        sCaptions(VBE_SITUATION) = "Situation: "
        sCaptions(VBE_SENDMAIL) = "Would you like to send the error message to support by email?"
    End If
    
    sCustProp = "SupportMail"   ' Name of cust doc prop for enable/disable sending error email
    
        ' Check if the doc prop for sending error info by email exist and is enabled
    If FindCustomDocProperty(sCustProp) Then
        bSendMail = ActiveDocument.CustomDocumentProperties(sCustProp).Value
    End If
    
End Sub



Attribute VB_Name = "UserRegSettings"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False



'
'
'
'   Project:        Macro libary
'   Customer:
'   Class Name:     UserRegSettings
'
'   Created:        2002-05-30  Lars-Eric Gisslén
'   Last Modified:  xxxx-xx-xx
'
'   Description:    Class for read/write user information to/from the registry
'


Option Explicit

Dim sAddress1 As String
Dim sAddress2 As String
Dim sAddressPrivate1 As String
Dim sAddressPrivate2 As String
Dim sBankgiro As String
Dim sCity As String
Dim sCityPrivate As String
Dim sCompany As String
Dim sCountry As String
Dim sDepartment As String
Dim sDivision As String
Dim sEmailUser As String
Dim sEmailCompany As String
Dim sFaxCompany As String
Dim sFaxCompanyIntl As String
Dim sFaxDirect As String
Dim sFaxDirectIntl As String
Dim sGroup As String
Dim sHandlingOfficer As String          ' Arbetsledare
Dim sNameFirst As String
Dim sNameLast As String
Dim sOrgNr As String
Dim sPersonNr As String
Dim sPhoneCompany As String
Dim sPhoneCompanyIntl As String
Dim sPhoneConnection As String
Dim sPhoneDirect As String
Dim sPhoneDirectIntl As String
Dim sPhoneMobile As String
Dim sPhoneMobileIntl As String
Dim sPhonePrivate As String
Dim sPostgiro As String
Dim sPostNr As String
Dim sPostNrPrivate As String
Dim sServicelocation As String          ' Tjänsteställe
Dim sSupervisor As String               ' Närmsta chef
Dim sVATNr As String
Dim sWebPage As String
Dim sVisitingaddress As String
Dim sVisitingaddress2 As String
Dim sTitle As String
Dim sEmpNumber As String

' ---- Property Get Methods -----------------------------------------------

Property Get Address1()
    Address1 = sAddress1
End Property
Property Get Address2()
    Address2 = sAddress2
End Property
Property Get AddressPrivate1()
    AddressPrivate1 = sAddressPrivate1
End Property
Property Get AddressPrivate2()
    AddressPrivate2 = sAddressPrivate2
End Property
Property Get Bankgiro()
    Bankgiro = sBankgiro
End Property
Property Get City()
    City = sCity
End Property
Property Get CityPrivate()
    CityPrivate = sCityPrivate
End Property
Property Get Company()
    Company = sCompany
End Property
Property Get Country()
    Country = sCountry
End Property
Property Get Department()
    Department = sDepartment
End Property
Property Get Division()
    Division = sDivision
End Property
Property Get EmailUser()
    EmailUser = sEmailUser
End Property
Property Get EmployeeNumber()
    EmployeeNumber = sEmpNumber
End Property
Property Get EmailCompany()
    EmailCompany = sEmailCompany
End Property
Property Get FaxCompany()
    FaxCompany = sFaxCompany
End Property
Property Get FaxCompanyIntl()
    FaxCompanyIntl = sFaxCompanyIntl
End Property
Property Get FaxDirect()
    FaxDirect = sFaxDirect
End Property
Property Get FaxDirectIntl()
    FaxDirectIntl = sFaxDirectIntl
End Property
Property Get Group()
    Group = sGroup
End Property
Property Get HandlingOfficer()
    HandlingOfficer = sHandlingOfficer
End Property
Property Get NameFirst()
    NameFirst = sNameFirst
End Property
Property Get NameLast()
    NameLast = sNameLast
End Property
Property Get OrgNr()
    OrgNr = sOrgNr
End Property
Property Get PersonNr()
    PersonNr = sPersonNr
End Property
Property Get PhoneCompany()
    PhoneCompany = sPhoneCompany
End Property
Property Get PhoneCompanyIntl()
    PhoneCompanyIntl = sPhoneCompanyIntl
End Property
Property Get PhoneConnection()
    PhoneConnection = sPhoneConnection
End Property
Property Get PhoneDirect()
    PhoneDirect = sPhoneDirect
End Property
Property Get PhoneDirectIntl()
    PhoneDirectIntl = sPhoneDirectIntl
End Property
Property Get PhoneMobile()
    PhoneMobile = sPhoneMobile
End Property
Property Get PhoneMobileIntl()
    PhoneMobileIntl = sPhoneMobileIntl
End Property
Property Get PhonePrivate()
    PhonePrivate = sPhonePrivate
End Property
Property Get Postgiro()
    Postgiro = sPostgiro
End Property
Property Get PostNr()
    PostNr = sPostNr
End Property
Property Get PostNrPrivate()
    PostNrPrivate = sPostNrPrivate
End Property
Property Get Servicelocation()
    Servicelocation = sServicelocation
End Property
Property Get Supervisor()
    Supervisor = sSupervisor
End Property
Property Get VATNr()
    VATNr = sVATNr
End Property
Property Get WebPage()
    WebPage = sWebPage
End Property
Property Get Visitingaddress()
    Visitingaddress = sVisitingaddress
End Property
Property Get Visitingaddress2()
    Visitingaddress2 = sVisitingaddress2
End Property
Property Get Title()
    Title = sTitle
End Property

' ---- Property Let Methods -----------------------------------------------

Property Let Address1(sText)
    sAddress1 = sText
End Property
Property Let Address2(sText)
    sAddress2 = sText
End Property
Property Let AddressPrivate1(sText)
    sAddressPrivate1 = sText
End Property
Property Let AddressPrivate2(sText)
    sAddressPrivate2 = sText
End Property
Property Let Bankgiro(sText)
    sBankgiro = sText
End Property
Property Let City(sText)
    sCity = sText
End Property
Property Let CityPrivate(sText)
    sCityPrivate = sText
End Property
Property Let Company(sText)
    sCompany = sText
End Property
Property Let Country(sText)
    sCountry = sText
End Property
Property Let Department(sText)
    sDepartment = sText
End Property
Property Let Division(sText)
    sDivision = sText
End Property
Property Let EmailUser(sText)
    sEmailUser = sText
End Property
Property Let EmailCompany(sText)
    sEmailCompany = sText
End Property
Property Let EmployeeNumber(sText)
    sEmpNumber = sText
End Property

Property Let FaxCompany(sText)
    sFaxCompany = sText
End Property
Property Let FaxCompanyIntl(sText)
    sFaxCompanyIntl = sText
End Property
Property Let FaxDirect(sText)
    sFaxDirect = sText
End Property
Property Let FaxDirectIntl(sText)
    sFaxDirectIntl = sText
End Property
Property Let Group(sText)
    sGroup = sText
End Property
Property Let HandlingOfficer(sText)
    sHandlingOfficer = sText
End Property
Property Let NameFirst(sText)
    sNameFirst = sText
End Property
Property Let NameLast(sText)
    sNameLast = sText
End Property
Property Let OrgNr(sText)
    sOrgNr = sText
End Property
Property Let PersonNr(sText)
    sPersonNr = sText
End Property
Property Let PhoneCompany(sText)
    sPhoneCompany = sText
End Property
Property Let PhoneCompanyIntl(sText)
    sPhoneCompanyIntl = sText
End Property
Property Let PhoneConnection(sText)
    sPhoneConnection = sText
End Property
Property Let PhoneDirect(sText)
    sPhoneDirect = sText
End Property
Property Let PhoneDirectIntl(sText)
    sPhoneDirectIntl = sText
End Property
Property Let PhoneMobile(sText)
    sPhoneMobile = sText
End Property
Property Let PhoneMobileIntl(sText)
    sPhoneMobileIntl = sText
End Property
Property Let PhonePrivate(sText)
    sPhonePrivate = sText
End Property
Property Let Postgiro(sText)
    sPostgiro = sText
End Property
Property Let PostNr(sText)
    sPostNr = sText
End Property
Property Let PostNrPrivate(sText)
    sPostNrPrivate = sText
End Property
Property Let Servicelocation(sText)
    sServicelocation = sText
End Property
Property Let Supervisor(sText)
    sSupervisor = sText
End Property
Property Let VATNr(sText)
    sVATNr = sText
End Property
Property Let WebPage(sText)
    sWebPage = sText
End Property
Property Let Visitingaddress(sText)
    sVisitingaddress = sText
End Property
Property Let Visitingaddress2(sText)
    sVisitingaddress2 = sText
End Property
Property Let Title(sText)
    sTitle = sText
End Property

Public Sub Save()
        ' Write all keys back to the registry
    Dim oError As ErrorObject
    Dim sSituation As String

    On Error GoTo ErrorHandler
        
    SaveSetting "SignOn", "UserInfo", "Address1", sAddress1
    SaveSetting "SignOn", "UserInfo", "Address2", sAddress2
    SaveSetting "SignOn", "UserInfo", "AddressPrivate1", sAddressPrivate1
    SaveSetting "SignOn", "UserInfo", "AddressPrivate2", sAddressPrivate2
    SaveSetting "SignOn", "UserInfo", "Bankgiro", sBankgiro
    SaveSetting "SignOn", "UserInfo", "City", sCity
    SaveSetting "SignOn", "UserInfo", "CityPrivate", sCityPrivate
    SaveSetting "SignOn", "UserInfo", "Company", sCompany
    SaveSetting "SignOn", "UserInfo", "Country", sCountry
    SaveSetting "SignOn", "UserInfo", "Division", sDivision
    SaveSetting "SignOn", "UserInfo", "Department", sDepartment
    SaveSetting "SignOn", "UserInfo", "EmailUser", sEmailUser
    SaveSetting "SignOn", "UserInfo", "EmailCompany", sEmailCompany
    SaveSetting "SignOn", "UserInfo", "FaxCompany", sFaxCompany
    SaveSetting "SignOn", "UserInfo", "FaxCompanyIntl", sFaxCompanyIntl
    SaveSetting "SignOn", "UserInfo", "FaxDirect", sFaxDirect
    SaveSetting "SignOn", "UserInfo", "FaxDirectIntl", sFaxDirectIntl
    SaveSetting "SignOn", "UserInfo", "Group", sGroup
    SaveSetting "SignOn", "UserInfo", "HandlingOfficer", sHandlingOfficer
    SaveSetting "SignOn", "UserInfo", "NameFirst", sNameFirst
    SaveSetting "SignOn", "UserInfo", "NameLast", sNameLast
    SaveSetting "SignOn", "UserInfo", "OrgNr", sOrgNr
    SaveSetting "SignOn", "UserInfo", "PersonNr", sPersonNr
    SaveSetting "SignOn", "UserInfo", "PhoneCompany", sPhoneCompany
    SaveSetting "SignOn", "UserInfo", "PhoneCompanyIntl", sPhoneCompanyIntl
    SaveSetting "SignOn", "UserInfo", "PhoneConnection", sPhoneConnection
    SaveSetting "SignOn", "UserInfo", "PhoneDirect", sPhoneDirect
    SaveSetting "SignOn", "UserInfo", "PhoneDirectIntl", sPhoneDirectIntl
    SaveSetting "SignOn", "UserInfo", "PhoneMobile", sPhoneMobile
    SaveSetting "SignOn", "UserInfo", "PhoneMobileIntl", sPhoneMobileIntl
    SaveSetting "SignOn", "UserInfo", "PhonePrivate", sPhonePrivate
    SaveSetting "SignOn", "UserInfo", "Postgiro", sPostgiro
    SaveSetting "SignOn", "UserInfo", "PostNr", sPostNr
    SaveSetting "SignOn", "UserInfo", "PostNrPrivate", sPostNrPrivate
    SaveSetting "SignOn", "UserInfo", "Servicelocation", sServicelocation
    SaveSetting "SignOn", "UserInfo", "Supervisor", sSupervisor
    SaveSetting "SignOn", "UserInfo", "VATNr", sVATNr
    SaveSetting "SignOn", "UserInfo", "WebPage", sWebPage
    SaveSetting "SignOn", "UserInfo", "Visitingaddress", sVisitingaddress
    SaveSetting "SignOn", "UserInfo", "Visitingaddress2", sVisitingaddress2
    SaveSetting "SignOn", "UserInfo", "Title", sTitle
    SaveSetting "SignOn", "UserInfo", "EmployeeNumber", sEmpNumber
    
    Exit Sub

ErrorHandler:
    Set oError = New ErrorObject
    oError.UseVBErrObject
    oError.MacroName = "UserRegSettings.Save()"
    oError.Situation = sSituation
    oError.Show
End Sub

Private Sub Class_Initialize()
        ' Read all keys from the registry into class variables
    Dim oError As ErrorObject
    Dim sSituation As String

    On Error GoTo ErrorHandler

        
    sAddress1 = GetSetting("SignOn", "UserInfo", "Address1")
    sAddress2 = GetSetting("SignOn", "UserInfo", "Address2")
    sAddressPrivate1 = GetSetting("SignOn", "UserInfo", "AddressPrivate1")
    sAddressPrivate2 = GetSetting("SignOn", "UserInfo", "AddressPrivate2")
    sBankgiro = GetSetting("SignOn", "UserInfo", "Bankgiro")
    sCity = GetSetting("SignOn", "UserInfo", "City")
    sCityPrivate = GetSetting("SignOn", "UserInfo", "CityPrivate")
    sCompany = GetSetting("SignOn", "UserInfo", "Company")
    sCountry = GetSetting("SignOn", "UserInfo", "Country")
    sDivision = GetSetting("SignOn", "UserInfo", "Division")
    sDepartment = GetSetting("SignOn", "UserInfo", "Department")
    sEmailUser = GetSetting("SignOn", "UserInfo", "EmailUser")
    sEmailCompany = GetSetting("SignOn", "UserInfo", "EmailCompany")
    sFaxCompany = GetSetting("SignOn", "UserInfo", "FaxCompany")
    sFaxCompanyIntl = GetSetting("SignOn", "UserInfo", "FaxCompanyIntl")
    sFaxDirect = GetSetting("SignOn", "UserInfo", "FaxDirect")
    sFaxDirectIntl = GetSetting("SignOn", "UserInfo", "FaxDirectIntl")
    sGroup = GetSetting("SignOn", "UserInfo", "Group")
    sHandlingOfficer = GetSetting("SignOn", "UserInfo", "HandlingOfficer")
    sNameFirst = GetSetting("SignOn", "UserInfo", "NameFirst")
    sNameLast = GetSetting("SignOn", "UserInfo", "NameLast")
    sOrgNr = GetSetting("SignOn", "UserInfo", "OrgNr")
    sPersonNr = GetSetting("SignOn", "UserInfo", "PersonNr")
    sPhoneCompany = GetSetting("SignOn", "UserInfo", "PhoneCompany")
    sPhoneCompanyIntl = GetSetting("SignOn", "UserInfo", "PhoneCompanyIntl")
    sPhoneConnection = GetSetting("SignOn", "UserInfo", "PhoneConnection")
    sPhoneDirect = GetSetting("SignOn", "UserInfo", "PhoneDirect")
    sPhoneDirectIntl = GetSetting("SignOn", "UserInfo", "PhoneDirectIntl")
    sPhoneMobile = GetSetting("SignOn", "UserInfo", "PhoneMobile")
    sPhoneMobileIntl = GetSetting("SignOn", "UserInfo", "PhoneMobileIntl")
    sPhonePrivate = GetSetting("SignOn", "UserInfo", "PhonePrivate")
    sPostgiro = GetSetting("SignOn", "UserInfo", "Postgiro")
    sPostNr = GetSetting("SignOn", "UserInfo", "PostNr")
    sPostNrPrivate = GetSetting("SignOn", "UserInfo", "PostNrPrivate")
    sServicelocation = GetSetting("SignOn", "UserInfo", "Servicelocation")
    sSupervisor = GetSetting("SignOn", "UserInfo", "Supervisor")
    sVATNr = GetSetting("SignOn", "UserInfo", "VATNr")
    sWebPage = GetSetting("SignOn", "UserInfo", "WebPage")
    sVisitingaddress = GetSetting("SignOn", "UserInfo", "Visitingaddress")
    sVisitingaddress2 = GetSetting("SignOn", "UserInfo", "Visitingaddress2")
    sTitle = GetSetting("SignOn", "UserInfo", "Title")
    sEmpNumber = GetSetting("SignOn", "UserInfo", "EmployeeNumber")
    
    Exit Sub

ErrorHandler:
    Set oError = New ErrorObject
    oError.UseVBErrObject
    oError.MacroName = "UserRegSettings.Class_Initialize()"
    oError.Situation = sSituation
    oError.Show
End Sub

Attribute VB_Name = "frmMain"
Attribute VB_Base = "0{681E1BDD-9C03-4F36-8678-5528A298ECDB}{31D07D39-BCCE-450A-A35C-71F6A8CA7C33}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False



'
'
'
'   Project:
'   Customer:       Norrköpings kommun
'   Form Name:      frmMain
'
'   Created:        2002-10-29  Lars-Eric Gisslén
'   Last Modified:  2004-06-29  Joakim Molin
'                       Added Mobilenumber.
'
'   Description:
'

Option Explicit
Dim bGetFromDocument As Boolean
Dim bInitializing As Boolean
Dim aDivisions As Variant

Private Sub cboDivision_Change()
    If Not bInitializing Then
        UpdateFooterControls
        Me.cmdSaveName.Enabled = True
    End If
End Sub

Private Sub chkOwnFooter_Click()
    UpdateFooterControls
    Me.cmdSaveOwnFooter.Enabled = False
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    System.Cursor = wdCursorWait
    FillDocument
    System.Cursor = wdCursorNormal
    SODocVariables.SetDocVariable "Used", "Yes"
    Unload Me
End Sub

Private Sub cmdSaveName_Click()
    SetUserInfo
    Me.cmdSaveName.Enabled = False
End Sub

Private Sub cmdSaveOwnFooter_Click()

    SaveSetting "SignOn", "UserFooter", "txtAddress1", Me.txtAddress1.Text
    SaveSetting "SignOn", "UserFooter", "txtPostAdr", Me.txtPostAdr.Text
    SaveSetting "SignOn", "UserFooter", "txtVisit1", Me.txtVisit1.Text
    SaveSetting "SignOn", "UserFooter", "txtVisit2", Me.txtVisit2.Text
    SaveSetting "SignOn", "UserFooter", "txtPhone", Me.txtPhone.Text
    SaveSetting "SignOn", "UserFooter", "txtPhoneVx", Me.txtPhoneVx.Text
    SaveSetting "SignOn", "UserFooter", "txtMobile", Me.txtMobile.Text
    SaveSetting "SignOn", "UserFooter", "txtFax", Me.txtFax.Text
    SaveSetting "SignOn", "UserFooter", "txtEMail", Me.txtEMail.Text
    SaveSetting "SignOn", "UserFooter", "txtInternet", Me.txtInternet.Text
    
    Me.cmdSaveOwnFooter.Enabled = False
    
End Sub

Private Sub txtAddress1_Change()
    ToggleSaveFooterButton
End Sub

Private Sub txtDepartment_Change()
    Me.cmdSaveName.Enabled = True
End Sub

Private Sub txtDirectPhone_Change()
    Me.cmdSaveName.Enabled = True
End Sub

Private Sub txtDivision_Change()
    Me.cmdSaveName.Enabled = True
End Sub

Private Sub txtEMail_Change()
    ToggleSaveFooterButton
End Sub

Private Sub txtFax_Change()
    ToggleSaveFooterButton
End Sub

Private Sub txtFirstName_Change()
    Me.cmdSaveName.Enabled = True
End Sub

Private Sub txtInternet_Change()
    ToggleSaveFooterButton
End Sub

Private Sub txtLastName_Change()
    Me.cmdSaveName.Enabled = True
End Sub

Private Sub txtPhone_Change()
    ToggleSaveFooterButton
End Sub

Private Sub txtPhoneVx_Change()
    ToggleSaveFooterButton
End Sub
Private Sub txtMobile_Change()
    ToggleSaveFooterButton
End Sub
Private Sub txtPostAdr_Change()
    ToggleSaveFooterButton
End Sub

Private Sub txtTitle_Change()
    Me.cmdSaveName.Enabled = True
End Sub

Private Sub txtVisit1_Change()
    ToggleSaveFooterButton
End Sub

Private Sub txtVisit2_Change()
    ToggleSaveFooterButton
End Sub

Private Sub UserForm_Initialize()
    Dim oError As ErrorObject
    Dim sSituation As String

    On Error GoTo ErrorHandler
    
    sSituation = "Getting addresses"
    aDivisions = Adresser.GetAddressArray()
    sSituation = ""
    
    bInitializing = True
    FillDivisionCombo
    bInitializing = False
    
    If Not bGetFromDocument Then
        Me.txtDate.Text = Format(Now(), "yyyy-MM-dd")
        GetUserInfo
    Else
        ' Get data from document (to be implemented)
    End If
    
    Me.cmdSaveName.Enabled = False
    
    Exit Sub

ErrorHandler:
    Set oError = New ErrorObject
    oError.UseVBErrObject
    oError.MacroName = "frmMain.UserForm_Initialize()"
    oError.Situation = sSituation
    oError.Show
End Sub

Private Sub GetUserInfo()
    Dim oUser As UserRegSettings
    Dim oError As ErrorObject
    Dim sSituation As String

    On Error GoTo ErrorHandler

    Set oUser = New UserRegSettings

    On Error Resume Next
    If Trim(oUser.Division) <> "" Then
        Me.cboDivision.Value = oUser.Division
        If Me.cboDivision.ListIndex < 0 Then
            Me.cboDivision.ListIndex = 0
        End If
        UpdateFooterControls
    End If
    On Error GoTo ErrorHandler
    Me.txtDepartment = oUser.Department
    Me.txtFirstName.Text = oUser.NameFirst
    Me.txtLastName.Text = oUser.NameLast
    Me.txtTitle.Text = oUser.Title
    Me.txtDirectPhone = oUser.PhoneDirect
    
    If Me.txtEMail.Text = "" Then
       ' Me.txtEMail.Text = "norrkoping.kommun@norrkoping.se"
    End If
    
    If Me.txtInternet.Text = "" Then
        Me.txtInternet.Text = "www.norrkoping.se"
    End If
    
    Set oUser = Nothing

    Exit Sub

ErrorHandler:
    Set oError = New ErrorObject
    oError.UseVBErrObject
    oError.MacroName = "frmMain.GetUserInfo"
    oError.Situation = sSituation
    oError.Show

End Sub

Private Sub SetUserInfo()
    Dim oUser As UserRegSettings
    Dim oError As ErrorObject
    Dim sSituation As String

    On Error GoTo ErrorHandler

    Set oUser = New UserRegSettings

    oUser.NameFirst = Me.txtFirstName.Text
    oUser.NameLast = Me.txtLastName.Text
    oUser.Title = Me.txtTitle.Text
    oUser.PhoneDirect = Me.txtDirectPhone
    oUser.Division = Me.cboDivision.Value
    oUser.Department = Me.txtDepartment

    oUser.Save

    Set oUser = Nothing

    Exit Sub

ErrorHandler:
    Set oError = New ErrorObject
    oError.UseVBErrObject
    oError.MacroName = "frmMain.SetUserInfo"
    oError.Situation = sSituation
    oError.Show

End Sub

Private Sub FillDocument()
    Dim sRecip As String
    Dim sNameTitle As String
    Dim oError As ErrorObject
    Dim sSituation As String
    Dim sFileName As String
    Dim sUrl As String
    Dim nItem As Long
    Dim oFF As FormField
    Dim oStory As Range
    Dim nType As Long
    Dim bLogoExist As Boolean

    On Error GoTo ErrorHandler
    
    sFileName = GetUniqueFilename.GetUniqueFilename
    nItem = Me.cboDivision.ListIndex
    If nItem > -1 Then
        SetCustDocProperty "Forvaltning", aDivisions(nItem)(AE_DISPNAME) 'Me.cboDivision.Text
        If aDivisions(nItem)(AE_LOGO) <> "" Then
            sUrl = LogoWebPath & aDivisions(nItem)(AE_LOGO)
            bLogoExist = GetLogotype(sUrl, sFileName)
            If Not bLogoExist Then sFileName = ""
        End If
    End If
    
…

Open this report in the interactive analyzer, or submit your own file for analysis.