Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 028c66d4b36c711c…

MALICIOUS

Office (OLE)

507.0 KB Created: 2016-08-16 05:35:00 Authoring application: Microsoft Office Word First seen: 2020-07-02
MD5: 5905fe16ed50340df6ca67e9dfa8eec6 SHA-1: 85ea6404b4d43cf5ff38e6eef8c4d2a5a0450572 SHA-256: 028c66d4b36c711c8af585db3417e53086aa28ef0df7ff1509bc068102df0a9a
230 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File

The presence of legacy WordBasic auto-exec markers and a significant amount of VBA macros, coupled with heuristics for WinExec, Shell calls, and CreateObject, strongly indicates malicious intent. The VBA macros likely facilitate the execution of arbitrary code, potentially downloading and running a secondary payload. The 'SE_LOLBIN_RUN_COMMAND' heuristic suggests the document text may contain obfuscated commands.

Heuristics 8

  • VBA macros detected medium 3 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
        If FldMailNr$ <> "" Then
        Shell FldMailNr$ + "\ClickYes.exe", vbMinimizedFocus
        ClickYesWnd = FindWindow("EXCLICKYES_WND", 0&)  ' Find ClickYes Window by classname
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    AdrRecID = GetAdressRecID()
Set VAdress = CreateObject("AbexOLE.VAdress")
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    End Sub
Public Sub AutoOpen()
Attribute AutoOpen.VB_Description = "AutoOpen\r\nCopyright Abex Software AG, CH-8957-Spreitenbach"
  • Reference to WinExec API high SC_STR_WINEXEC
    Reference to WinExec API
  • LOLBin token sequence in document text high SE_LOLBIN_RUN_COMMAND
    Extracted document text contains a Windows script/execution tool name (PowerShell, mshta, cmd, rundll32, regsvr32, …) within 220 characters of a dangerous flag, command verb, or URL. This is a visible 'run this' instruction in HTML/PDF/RTF lure bodies, or — in macro-laden Office files — the macro's own string-pool entries appearing adjacent in extracted text.
  • 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.
  • 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://schemas.openxmlformats.org/drawingml/2006/main In document text (OLE body)
    • http://www.w3.org/2000/09/xmldsig#In document text (OLE body)
    • http://www.w3.org/TR/2001/REC-xml-c14n-20010315In document text (OLE body)
    • http://www.w3.org/2001/04/xmldsig-more#rsa-sha256In document text (OLE body)
    • http://www.w3.org/2000/09/xmldsig#ObjectIn document text (OLE body)
    • http://www.w3.org/2001/04/xmlenc#sha256In document text (OLE body)
    • http://uri.etsi.org/01903#SignedPropertiesIn document text (OLE body)
    • http://schemas.openxmlformats.org/package/2006/digital-signatureIn document text (OLE body)
    • http://schemas.microsoft.com/office/2006/digsigIn document text (OLE body)
    • http://uri.etsi.org/01903/v1.3.2#In document text (OLE body)
    • http://uri.etsi.org/01903/v1.2.2#ProofOfCreationIn 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) 398336 bytes
SHA-256: a1c0df2a0132f3803868a4a129459537fd94192bf04400b3ba914a6c1e246ab8
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "0{00020906-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "AbexFrmFelder"
Attribute VB_Base = "0{106E3227-2706-4A81-8A24-E8F42FEFA57E}{4C524557-7D4D-4556-B935-97F67886459B}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
Dim Mas_PublicPfad$
Private Sub Cancel_Auft_Click()
Me.Hide
End Sub
Private Sub Cancel_Favoriten_Click()
Me.Hide
End Sub
Private Sub Cancel_Kopf_Click()
Me.Hide
End Sub
Private Sub Cancel_Pos_Click()
Me.Hide
End Sub
Private Sub Cancel_Projekt_Click()
Me.Hide
End Sub
Private Sub Lis_Auft_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call OK_Auft_Click
End Sub
Private Sub Lis_Kopf_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call OK_Kopf_Click
End Sub
Private Sub Lis_Pos_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call OK_Pos_Click
End Sub
Private Sub Lis_Projekt_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call OK_Projekt_Click
End Sub
Private Sub OK_Adresse_Click()
On Local Error Resume Next
Dim FldNr As Integer
Dim Tx$
Dim FürWahl$
Dim InklVorwahl$
Dim DatumAufber$
Tx$ = Me.Lis_Adresse.List(Me.Lis_Adresse.ListIndex)
FürWahl$ = AbexText(51)
InklVorwahl$ = AbexText(52)
DatumAufber$ = AbexText(56)
If Right(Tx$, Len(FürWahl$)) = FürWahl$ Then
    ' Aufbereitet für automatische Wahl (Nur Ziffern)
    Tx$ = Left(Tx$, Len(Tx$) - Len(FürWahl$))
    For FldNr = 1 To AnzAdressFelder
        If FldRef(2, FldNr) = Tx$ Then
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDDE, Text:="VAdress Adress SpezDDE(" + CStr(FldNr) + ")", PreserveFormatting:=True
            ActiveWindow.View.ShowFieldCodes = False
            Exit For
        End If
    Next FldNr
ElseIf Right(Tx$, Len(InklVorwahl$)) = InklVorwahl$ Then
    ' Aufbereitet inkl Landes+Kantonsvorwahl
    Tx$ = Left(Tx$, Len(Tx$) - Len(InklVorwahl$))
    For FldNr = 1 To AnzAdressFelder
        If FldRef(2, FldNr) = Tx$ Then
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDDE, Text:="VAdress Adress TextRahmen(" + CStr(FldNr) + ")", PreserveFormatting:=True
            ActiveWindow.View.ShowFieldCodes = False
            Exit For
        End If
    Next FldNr
ElseIf Right(Tx$, Len(DatumAufber$)) = DatumAufber$ Then
    ' Aufbereitetes Datumfeld
    Tx$ = Left(Tx$, Len(Tx$) - Len(DatumAufber$))
    For FldNr = 1 To AnzAdressFelder
        If FldRef(2, FldNr) = Tx$ Then
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDDE, Text:="VAdress Adress Text(" + CStr(FldNr) + ") \@" + Chr(34) + "d. MMMM yyyy" + Chr(34) + " ", PreserveFormatting:=True
            ActiveWindow.View.ShowFieldCodes = False
            Exit For
        End If
    Next FldNr
Else
    ' Normal
    For FldNr = 1 To AnzAdressFelder
        If FldRef(2, FldNr) = Tx$ Then
            If UCase(FldRef(3, FldNr)) = "X" Then
                Call BildEinfügen("ADRESS", "VA_BILD", FldNr)
            Else
                Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDDE, Text:="VAdress Adress Text(" + CStr(FldNr) + ")", PreserveFormatting:=True
                ActiveWindow.View.ShowFieldCodes = False
            End If
            Exit For
        End If
    Next FldNr
End If
Me.Hide
End Sub
Private Sub OK_Auft_Click()
On Local Error Resume Next
Dim FldNr As Integer
Dim Tx$
Dim FormatStr$

FormatStr$ = ""
Tx$ = Me.Lis_Auft.List(Me.Lis_Auft.ListIndex)
For FldNr = 1 To AnzAuftFelder
    If AuftRef(2, FldNr) = Tx$ Then
        FormatStr$ = AuftRef(3, FldNr)
        Selection.TypeText Text:=Chr(123) + "a" + Right("000" + CStr(AuftRef(1, FldNr)), 3) + FormatStr$ + Chr(125)
        Exit For
    End If
Next FldNr
Me.Hide
End Sub
Private Sub OK_Doku_Click()
On Local Error Resume Next
Dim FldNr As Integer
Dim Tx$
Dim DatumAufber$
Tx$ = Me.Lis_Doku.List(Me.Lis_Doku.ListIndex)
DatumAufber$ = AbexText(56)
If Right(Tx$, Len(DatumAufber$)) = DatumAufber$ Then
    ' Aufbereitetes Datumfeld
    Tx$ = Left(Tx$, Len(Tx$) - Len(DatumAufber$))
    For FldNr = 1 To AnzAdressFelder
        If FldRef(2, FldNr) = Tx$ Then
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDDE, Text:="VAdress Doku Text(" + CStr(FldNr) + ") \@" + Chr(34) + "d. MMMM yyyy" + Chr(34) + " ", PreserveFormatting:=True
            ActiveWindow.View.ShowFieldCodes = False
            Exit For
        End If
    Next FldNr
Else
    ' Normal
    For FldNr = 1 To AnzDokuFelder
        If DokuRef(2, FldNr) = Tx$ Then
            If UCase(DokuRef(3, FldNr)) = "X" Then
                Call BildEinfügen("Doku", "DOKU_BILD", FldNr)
            Else
                Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDDE, Text:="VAdress Doku Text(" + CStr(FldNr) + ")", PreserveFormatting:=True
            End If
            ActiveWindow.View.ShowFieldCodes = False
            Exit For
        End If
    Next FldNr
End If
Me.Hide
End Sub
Private Sub OK_Favoriten_Click()
On Local Error Resume Next
Dim Tx$
Select Case Me.Lis_Favoriten.ListIndex
Case 0
    Tx$ = "VAdress User Absender"
Case 1
    Tx$ = "VAdress Adress Adresse"
Case 2
    Tx$ = "VAdress Adress Text(33)"
Case 3
    Tx$ = "VAdress Doku Text(3) \@" + Chr(34) + "d. MMMM yyyy" + Chr(34) + " "
Case 5
    Tx$ = "VAdress Adress KorrespAdresse"
Case 6
    Tx$ = "VAdress Adress KorrespBriefanrede"
Case 7
    Tx$ = "VAdress Adress MutterAdresse"
Case 8
    Tx$ = "VAdress Adress MutterBriefanrede"
Case 9
    Tx$ = "VAdress Adress ZusatzAdresse(1)"
Case 10
    Tx$ = "VAdress Adress ZusatzAdresse(2)"
Case 11
    Tx$ = "VAdress Adress ZusatzAdresse(3)"
Case Else
    Tx$ = "<<>>"
End Select
If Tx$ <> "<<>>" Then
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDDE, Text:=Tx$, PreserveFormatting:=True
    ActiveWindow.View.ShowFieldCodes = False
End If
Me.Hide
End Sub
Private Sub Lis_Favoriten_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call OK_Favoriten_Click
End Sub
Private Sub Cancel_Absender_Click()
Me.Hide
End Sub
Private Sub OK_Absender_Click()
On Local Error Resume Next
Dim Tx$
Select Case Me.Lis_Absender.ListIndex
Case 0
    Tx$ = "VAdress User Vorname"
Case 1
    Tx$ = "VAdress User Nachname"
Case 2
    Tx$ = "VAdress User VornameNachname"
Case 3
    Tx$ = "VAdress User Nr"
Case 4
    Tx$ = "VAdress User Kurzzeichen"
Case 5
    Tx$ = "VAdress User SprachCode"
Case 6
    Tx$ = "VAdress User Sprache"
Case 7
    Tx$ = "VAdress User Funktion"
Case 8
    Tx$ = "VAdress User Firma"
Case 9
    Tx$ = "VAdress User Zusatz"
Case 10
    Tx$ = "VAdress User Abteilung"
Case 11
    Tx$ = "VAdress User Strasse"
Case 12
    Tx$ = "VAdress User Land"
Case 13
    Tx$ = "VAdress User PLZ"
Case 14
    Tx$ = "VAdress User Ort"
Case 15
    Tx$ = "VAdress User TelZentr"
Case 16
    Tx$ = "VAdress User TelDirekt"
Case 17
    Tx$ = "VAdress User Fax"
Case 18
    Tx$ = "VAdress User Internet"
Case 19
    Tx$ = "VAdress User Mail"
Case 20
    Tx$ = "VAdress User Telex"
Case 21, 22 ' Benutzer Foto, Benutzer Signatur
    If Me.Lis_Absender.ListIndex = 21 Then
        Call BildEinfügen("USER", "USER_FOTO", 0)
    Else
        Call BildEinfügen("USER", "USER_SIGN", 0)
    End If
    GoTo OK_AbsenderEnde
Case Else
    Tx$ = "<<>>"
End Select
If Tx$ <> "<<>>" Then
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDDE, Text:=Tx$, PreserveFormatting:=True
    ActiveWindow.View.ShowFieldCodes = False
End If
OK_AbsenderEnde:
Me.Hide
End Sub
Private Sub Lis_Absender_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call OK_Absender_Click
End Sub
Private Sub Cancel_Doku_Click()
Me.Hide
End Sub
Private Sub Lis_Doku_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call OK_Doku_Click
End Sub
Private Sub Cancel_Adresse_Click()
Me.Hide
End Sub
Private Sub Lis_Adresse_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call OK_Adresse_Click
End Sub
Private Sub OK_Kopf_Click()
On Local Error Resume Next
Dim FldNr As Integer
Dim Tx$
Dim DatumAufber$
Dim FormatStr$
FormatStr$ = ""
DatumAufber$ = AbexText(56)
Tx$ = Me.Lis_Kopf.List(Me.Lis_Kopf.ListIndex)
If Right(Tx$, Len(DatumAufber$)) = DatumAufber$ Then
    FormatStr$ = "005"  ' Aufbereitetes Datumfeld
End If
' Normal
For FldNr = 1 To AnzKopfFelder
    If KopfRef(2, FldNr) = Tx$ Then
        Selection.TypeText Text:=Chr(123) + "k" + Right("000" + CStr(FldNr), 3) + FormatStr$ + Chr(125)
        Exit For
    End If
Next FldNr
Me.Hide
End Sub
Private Sub OK_Pos_Click()
On Local Error Resume Next
Dim FldNr As Integer
Dim Tx$
Dim DatumAufber$
Dim FormatStr$
FormatStr$ = ""
DatumAufber$ = AbexText(56)
Tx$ = Me.Lis_Pos.List(Me.Lis_Pos.ListIndex)
If Right(Tx$, Len(DatumAufber$)) = DatumAufber$ Then
    FormatStr$ = "005"  ' Aufbereitetes Datumfeld
End If
' Normal
For FldNr = 1 To AnzPosFelder
    If PosRef(2, FldNr) = Tx$ Then
        Selection.TypeText Text:=Chr(123) + "p" + Right("000" + CStr(FldNr), 3) + FormatStr$ + Chr(125)
        Exit For
    End If
Next FldNr
Me.Hide
End Sub
Private Sub OK_Projekt_Click()
On Local Error Resume Next
Dim FldNr As Integer
Dim Tx$
Dim DatumAufber$
DatumAufber$ = AbexText(56)
Tx$ = Me.Lis_Projekt.List(Me.Lis_Projekt.ListIndex)
If Right(Tx$, Len(DatumAufber$)) = DatumAufber$ Then
    ' Aufbereitetes Datumfeld
    Tx$ = Left(Tx$, Len(Tx$) - Len(DatumAufber$))
    For FldNr = 1 To AnzAdressFelder
        If FldRef(2, FldNr) = Tx$ Then
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDDE, Text:="VAdress Projekt Text(" + CStr(FldNr) + ") \@" + Chr(34) + "d. MMMM yyyy" + Chr(34) + " ", PreserveFormatting:=True
            ActiveWindow.View.ShowFieldCodes = False
            Exit For
        End If
    Next FldNr
Else
    ' Normal
    For FldNr = 1 To AnzProjektFelder
        If ProjektRef(2, FldNr) = Tx$ Then
            If UCase(ProjektRef(3, FldNr)) = "X" Then
                Call BildEinfügen("PROJEKT", "PR_BILD", FldNr)
            Else
                Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDDE, Text:="VAdress Projekt Text(" + CStr(FldNr) + ")", PreserveFormatting:=True
                ActiveWindow.View.ShowFieldCodes = False
            End If
            Exit For
        End If
    Next FldNr
End If
Me.Hide
End Sub
Private Sub UserForm_Activate()
On Local Error Resume Next
If Mas_PublicPfad$ = "" Then
    Mas_PublicPfad$ = WordBasic.[GetPrivateProfileString$]("HKEY_LOCAL_MACHINE\Software\Abex\Visual-Adress 5\Settings", "AbexDataDir", "") + "Public\"
End If
If Val(System.PrivateProfileString(Mas_PublicPfad$ + "Abex.ini", "Einstellung", "Auftrag_In_Word")) = 0 Then
    Me.MultiPage1.Pages.Item(7).Visible = False
    Me.MultiPage1.Pages.Item(6).Visible = False
    Me.MultiPage1.Pages.Item(5).Visible = False
Else
    Me.MultiPage1.Pages.Item(7).Visible = True
    Me.MultiPage1.Pages.Item(6).Visible = True
    Me.MultiPage1.Pages.Item(5).Visible = True
End If
End Sub
Private Sub UserForm_Initialize()
On Local Error Resume Next
Dim i As Integer
' --- Favoriten ---
Me.Caption = AbexText(99)
Me.MultiPage1.Pages.Item(0).Caption = AbexText(100)
Me.Cancel_Favoriten.Caption = AbexText(50)
Me.Lis_Favoriten.Clear
For i = 101 To 104
    Me.Lis_Favoriten.AddItem AbexText(i)
Next i
Me.Lis_Favoriten.AddItem String(44, "-")
For i = 105 To 111
    Me.Lis_Favoriten.AddItem AbexText(i)
Next i
' --- Benutzer ---
Me.MultiPage1.Pages.Item(1).Caption = AbexText(200)
Set Me.MultiPage1.Pages.Item(1).Picture = Me.MultiPage1.Pages.Item(0).Picture
Me.Cancel_Absender.Caption = AbexText(50)
Me.Lis_Absender.Clear
For i = 201 To 207
    Me.Lis_Absender.AddItem AbexText(i)
Next i
Me.Lis_Absender.AddItem AbexText(190)
' --- Absender ---
For i = 208 To 222
    Me.Lis_Absender.AddItem AbexText(i)
Next i
' --- Doku ---
Me.MultiPage1.Pages.Item(2).Caption = AbexText(300)
Set Me.MultiPage1.Pages.Item(2).Picture = Me.MultiPage1.Pages.Item(0).Picture
Me.Cancel_Doku.Caption = AbexText(50)
Me.Lis_Doku.Clear
For i = 301 To 311
    Me.Lis_Doku.AddItem AbexText(i)
Next i
AnzDokuFelder = 0
DokuRef(1, 1) = ""
' --- Adresse ---
Me.MultiPage1.Pages.Item(3).Caption = AbexText(400)
Set Me.MultiPage1.Pages.Item(3).Picture = Me.MultiPage1.Pages.Item(0).Picture
Me.Cancel_Adresse.Caption = AbexText(50)
AnzAdressFelder = 0
FldRef(1, 1) = ""
' --- Projekt ---
Me.MultiPage1.Pages.Item(4).Caption = AbexText(306)
Set Me.MultiPage1.Pages.Item(4).Picture = Me.MultiPage1.Pages.Item(0).Picture
Me.Cancel_Projekt.Caption = AbexText(50)
AnzProjektFelder = 0
ProjektRef(1, 1) = ""
' --- Auftrags-Allg ---
Me.MultiPage1.Pages.Item(5).Caption = AbexText(350)
Set Me.MultiPage1.Pages.Item(5).Picture = Me.MultiPage1.Pages.Item(0).Picture
Me.Cancel_Auft.Caption = AbexText(50)
AnzKopfFelder = 0
AuftRef(1, 1) = ""
' --- Auftrags-Kopf ---
Me.MultiPage1.Pages.Item(6).Caption = AbexText(351)
Set Me.MultiPage1.Pages.Item(6).Picture = Me.MultiPage1.Pages.Item(0).Picture
Me.Cancel_Kopf.Caption = AbexText(50)
AnzKopfFelder = 0
KopfRef(1, 1) = ""
' --- Auftrags-Pos ---
Me.MultiPage1.Pages.Item(7).Caption = AbexText(352)
Set Me.MultiPage1.Pages.Item(7).Picture = Me.MultiPage1.Pages.Item(0).Picture
Me.Cancel_Pos.Caption = AbexText(50)
AnzPosFelder = 0
PosRef(1, 1) = ""
End Sub
Private Sub MultiPage1_Change()
Dim FldNr As Integer
Dim l As Long
Dim Index As Integer
Select Case Me.MultiPage1.SelectedItem.Index
Case 0
    Me.Cancel_Favoriten.Cancel = True
Case 1
    Me.Cancel_Absender.Cancel = True
Case 2
    Me.Cancel_Doku.Cancel = True
    Me.MousePointer = fmMousePointerHourGlass
    DoEvents
    Call AbexDokuBezEinlesen
    Me.Lis_Doku.Clear
    For FldNr = 1 To AnzDokuFelder
        If DokuRef(2, FldNr) <> "" Then
            Index = -1
            For l = Me.Lis_Doku.ListCount To 1 Step -1
                If DokuRef(2, FldNr) < Me.Lis_Doku.List(l - 1) Then
                    Index = l - 1
                Else
                    Exit For
                End If
            Next l
            If Index >= 0 Then
                Me.Lis_Doku.AddItem DokuRef(2, FldNr), Index
            Else
                Me.Lis_Doku.AddItem DokuRef(2, FldNr)
            End If
        End If
    Next FldNr
    Me.MousePointer = fmMousePointerDefault
Case 3
    Me.Cancel_Adresse.Cancel = True
    Me.MousePointer = fmMousePointerHourGlass
    DoEvents
    Call AbexFldBezEinlesen
    Me.Lis_Adresse.Clear
    For FldNr = 1 To AnzAdressFelder
        If FldRef(2, FldNr) <> "" Then
            Index = -1
            For l = Me.Lis_Adresse.ListCount To 1 Step -1
                If FldRef(2, FldNr) < Me.Lis_Adresse.List(l - 1) Then
                    Index = l - 1
                Else
                    Exit For
                End If
            Next l
            If Index >= 0 Then
                Me.Lis_Adresse.AddItem FldRef(2, FldNr), Index
            Else
                Me.Lis_Adresse.AddItem FldRef(2, FldNr)
            End If
            
            If FldRef(3, FldNr) = "F" Or FldRef(3, FldNr) = "T" Then
                If Index >= 0 Then
                    Me.Lis_Adresse.AddItem FldRef(2, FldNr) + AbexText(51), Index + 1
                    Me.Lis_Adresse.AddItem FldRef(2, FldNr) + AbexText(52), Index + 1
                Else
                    Me.Lis_Adresse.AddItem FldRef(2, FldNr) + AbexText(51)
                    Me.Lis_Adresse.AddItem FldRef(2, FldNr) + AbexText(52)
                End If
            ElseIf FldRef(3, FldNr) = "D" Then
                If Index >= 0 Then
                    Me.Lis_Adresse.AddItem FldRef(2, FldNr) + AbexText(56), Index + 1
                Else
                    Me.Lis_Adresse.AddItem FldRef(2, FldNr) + AbexText(56)
                End If
            End If
        End If
    Next FldNr
    Me.MousePointer = fmMousePointerDefault
Case 4
    Me.Cancel_Projekt.Cancel = True
    Me.MousePointer = fmMousePointerHourGlass
    DoEvents
    Call AbexProjektBezEinlesen
    Me.Lis_Projekt.Clear
    For FldNr = 1 To AnzProjektFelder
        If ProjektRef(2, FldNr) <> "" Then
            Index = -1
            For l = Me.Lis_Projekt.ListCount To 1 Step -1
                If ProjektRef(2, FldNr) < Me.Lis_Projekt.List(l - 1) Then
                    Index = l - 1
                Else
                    Exit For
                End If
            Next l
            If Index >= 0 Then
                Me.Lis_Projekt.AddItem ProjektRef(2, FldNr), Index
            Else
                Me.Lis_Projekt.AddItem ProjektRef(2, FldNr)
            End If
            If ProjektRef(3, FldNr) = "F" Or ProjektRef(3, FldNr) = "T" Then
                If Index >= 0 Then
                    Me.Lis_Projekt.AddItem ProjektRef(2, FldNr) + AbexText(51), Index + 1
                    Me.Lis_Projekt.AddItem ProjektRef(2, FldNr) + AbexText(52), Index + 1
                Else
                    Me.Lis_Projekt.AddItem ProjektRef(2, FldNr) + AbexText(51)
                    Me.Lis_Projekt.AddItem ProjektRef(2, FldNr) + AbexText(52)
                End If
            ElseIf ProjektRef(3, FldNr) = "D" Then
                If Index >= 0 Then
                    Me.Lis_Projekt.AddItem ProjektRef(2, FldNr) + AbexText(56), Index + 1
                Else
                    Me.Lis_Projekt.AddItem ProjektRef(2, FldNr) + AbexText(56)
                End If
            End If
        End If
    Next FldNr
    Me.MousePointer = fmMousePointerDefault
Case 5
    Me.Cancel_Auft.Cancel = True
    Me.MousePointer = fmMousePointerHourGlass
    DoEvents
    Call AbexAuftBezEinlesen
    Me.Lis_Auft.Clear
    For FldNr = 1 To AnzAuftFelder
        If AuftRef(2, FldNr) <> "" Then
            Index = -1
            For l = Me.Lis_Auft.ListCount To 1 Step -1
                If AuftRef(2, FldNr) < Me.Lis_Auft.List(l - 1) Then
                    Index = l - 1
                Else
                    Exit For
                End If
            Next l
            If Index >= 0 Then
                Me.Lis_Auft.AddItem AuftRef(2, FldNr), Index
            Else
                Me.Lis_Auft.AddItem AuftRef(2, FldNr)
            End If
        End If
    Next FldNr
    Me.MousePointer = fmMousePointerDefault
Case 6
    Me.Cancel_Kopf.Cancel = True
    Me.MousePointer = fmMousePointerHourGlass
    DoEvents
    Call AbexKopfBezEinlesen
    Me.Lis_Kopf.Clear
    For FldNr = 1 To AnzKopfFelder
        If KopfRef(2, FldNr) <> "" Then
            Index = -1
            For l = Me.Lis_Kopf.ListCount To 1 Step -1
                If KopfRef(2, FldNr) < Me.Lis_Kopf.List(l - 1) Then
                    Index = l - 1
                Else
                    Exit For
                End If
            Next l
            If Index >= 0 Then
                Me.Lis_Kopf.AddItem KopfRef(2, FldNr), Index
            Else
                Me.Lis_Kopf.AddItem KopfRef(2, FldNr)
            End If
            If KopfRef(3, FldNr) = "D" Then
                If Index >= 0 Then
                    Me.Lis_Kopf.AddItem KopfRef(2, FldNr) + AbexText(56), Index + 1
                Else
                    Me.Lis_Kopf.AddItem KopfRef(2, FldNr) + AbexText(56)
                End If
            End If
        End If
    Next FldNr
    Me.MousePointer = fmMousePointerDefault
Case 7
    Me.Cancel_Pos.Cancel = True
    Me.MousePointer = fmMousePointerHourGlass
    DoEvents
    Call AbexPosBezEinlesen
    Me.Lis_Pos.Clear
    For FldNr = 1 To AnzPosFelder
        If PosRef(2, FldNr) <> "" Then
            Index = -1
            For l = Me.Lis_Pos.ListCount To 1 Step -1
                If PosRef(2, FldNr) < Me.Lis_Pos.List(l - 1) Then
                    Index = l - 1
                Else
                    Exit For
                End If
            Next l
            If Index >= 0 Then
                Me.Lis_Pos.AddItem PosRef(2, FldNr), Index
            Else
                Me.Lis_Pos.AddItem PosRef(2, FldNr)
            End If
            If PosRef(3, FldNr) = "D" Then
                If Index >= 0 Then
                    Me.Lis_Pos.AddItem PosRef(2, FldNr) + AbexText(56), Index + 1
                Else
                    Me.Lis_Pos.AddItem PosRef(2, FldNr) + AbexText(56)
                End If
            End If
        End If
    Next FldNr
    Me.MousePointer = fmMousePointerDefault
End Select
End Sub

Attribute VB_Name = "AbexFrmFunktionen"
Attribute VB_Base = "0{C57F9B05-3B33-4851-9523-FEC18DE22546}{07DC1AC1-7F60-4F4F-87B4-B9E243FDFA67}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False



Option Explicit
Dim Mas_Click As Boolean
Private Sub OptionSetzen(OptionNr As Integer)
' --- OptionNr 0=links, 1=Oben ---
Mas_Click = False
If OptionNr = 1 Then
    Me.Opt_Links.Value = False
    Me.Opt_Oben.Value = True
Else
    Me.Opt_Oben.Value = False
    Me.Opt_Links.Value = True
End If
Mas_Click = True
End Sub
Private Sub BildLinks1_Click()
Call OptionSetzen(0)
End Sub
Private Sub BildLinks2_Click()
Call OptionSetzen(0)
End Sub
Private Sub BildLinks3_Click()
Call OptionSetzen(0)
End Sub
Private Sub BildOben1_Click()
Call OptionSetzen(1)
End Sub
Private Sub BildOben2_Click()
Call OptionSetzen(1)
End Sub
Private Sub BildOben3_Click()
Call OptionSetzen(1)
End Sub
Private Sub FrameLinks_Click()
Call OptionSetzen(0)
End Sub
Private Sub FrameOben_Click()
Call OptionSetzen(1)
End Sub
Private Sub Kno_Abbrechen_Click()
Unload Me
End Sub
Private Sub Kno_OK_Click()
If Me.Opt_Links.Value Then
    Selection.InsertFormula Formula:="=SUM(LINKS)", NumberFormat:="#'##0.00"
Else
    Selection.InsertFormula Formula:="=SUM(ÜBER)", NumberFormat:="#'##0.00"
End If
Unload Me
End Sub
Private Sub Opt_Links_Click()
If Mas_Click Then
    Call OptionSetzen(0)
End If
End Sub
Private Sub Opt_Oben_Change()
If Mas_Click Then
    Call OptionSetzen(1)
End If
End Sub
Private Sub UserForm_Initialize()
Mas_Click = True
Me.Caption = AbexText(30)
Me.Kno_Abbrechen.Caption = AbexText(50)
Me.Label1.Caption = AbexText(31)
Me.FrameLinks.Caption = AbexText(32)
Me.FrameOben.Caption = AbexText(33)
End Sub


Attribute VB_Name = "AbexFrmMailOptionen"
Attribute VB_Base = "0{717E50C0-82C1-4500-A23E-D0549508395D}{53476212-470B-4109-8A35-4568DF8B6443}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False





Private Sub Cancel_MailOptionen_Click()
Me.Tag = ""
Me.Hide
End Sub
Private Sub OK_MailOptionen_Click()
Me.Tag = "OK"
Me.Hide
End Sub
Private Sub UserForm_Initialize()
Me.Caption = AbexText(20)
Me.Lbl_Subjekt.Caption = AbexText(21)
Me.MailOptionen1.Caption = AbexText(22)
Me.MailOptionen2.Caption = AbexText(23)
Me.Cancel_MailOptionen.Caption = AbexText(50)
End Sub

Attribute VB_Name = "AbexFrmMenu"
Attribute VB_Base = "0{7B1399EA-ED4B-44D9-9791-13C4D4407F54}{A90E8A47-E046-4A2D-B8FF-4C901DFE3D35}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Sub TexteEinlesen()
ReDim FldRef(1 To 3, 1 To 1)
ReDim DokuRef(1 To 3, 1 To 1)
FldRef(1, 1) = ""
DokuRef(1, 1) = ""
Me.Caption = AbexText(1)
Me.Tit_Allgem.Caption = AbexText(2)
Me.Kno_Optionen.Caption = AbexText(3)
Me.Kno_Feld.Caption = AbexText(4)
Me.Kno_Funktionen.Caption = AbexText(13)
Me.Tit_Einzelbrief.Caption = AbexText(5)
Me.Kno_Aktualisieren.Caption = AbexText(6)
Me.Kno_Drucken.Caption = AbexText(7)
Me.Kno_Mail.Caption = AbexText(14)
Me.Kno_Faxen.Caption = AbexText(8)
Me.Tit_Serienbrief.Caption = AbexText(9)
Me.Kno_SerienDruck.Caption = AbexText(10)
Me.Kno_SerienFax.Caption = AbexText(11)
Me.Kno_SerienMail.Caption = AbexText(12)
Me.Kno_FeldInText.Caption = AbexText(15)
End Sub
Private Sub Kno_Feld_Click()
Me.Hide
AbexFrmFelder.Show
End Sub
Private Sub Kno_Aktualisieren_Click()
AbexKonvertToDDE
Me.Hide
End Sub
Private Sub Kno_Drucken_Click()
Me.Hide
AbexKonvertToDDE
ActiveDocument.PrintOut
End Sub
Private Sub Kno_FeldInText_Click()
AbexFelderzuText
Me.Hide
End Sub
Private Sub Kno_Funktionen_Click()
Me.Hide
AbexFrmFunktionen.Show
End Sub
Private Sub Kno_Faxen_Click()
Me.Hide
Call AbexEinzelFax
End Sub
Private Sub Kno_Mail_Click()
Me.Hide
Call AbexEinzelMail
End Sub
Private Sub Kno_Optionen_Click()
AbexFrmOptionen.Show
a$ = AbexText(1, True)
Call Me.TexteEinlesen
End Sub
Private Sub Kno_SerienDruck_Click()
Me.Hide
Call AbexSerienbriefDrucken
End Sub
Private Sub Kno_SerienFax_Click()
Me.Hide
Call AbexSerienbriefFaxen
End Sub
Private Sub Kno_SerienMail_Click()
Me.Hide
Call AbexSerienbriefMailen
End Sub
Private Sub UserForm_Initialize()
Call Me.TexteEinlesen
End Sub

Attribute VB_Name = "AbexFrmOptionen"
Attribute VB_Base = "0{12093EE5-657C-4639-98E0-A6E6BB1413B0}{096BF573-B348-4BD5-8D25-F9C34ED9A5DD}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub Cancel_Optionen_Click()
Me.Hide
End Sub
Private Sub OK_Optionen_Click()
If Me.Kno_Nie.Value Then
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "FrageninWinWord") = "0"
ElseIf Kno_VorschlagNein.Value Then
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "FrageninWinWord") = "1"
ElseIf Kno_VorschlagJa.Value Then
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "FrageninWinWord") = "2"
Else
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "FrageninWinWord") = "3"
End If
If Me.Kno_SpracheD.Value Then
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "WinWordSprache") = "1"
    ProgSprache$ = "D"
ElseIf Me.Kno_SpracheF.Value Then
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "WinWordSprache") = "2"
    ProgSprache$ = "F"
ElseIf Me.Kno_SpracheE.Value Then
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "WinWordSprache") = "4"
    ProgSprache$ = "E"
Else
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "WinWordSprache") = "0"
    ProgSprache$ = ""
End If
Unload Me
End Sub
Private Sub UserForm_Initialize()
Me.Label1.Caption = AbexText(66)
Me.Kno_Immer.Caption = AbexText(67)
Me.Kno_VorschlagJa.Caption = AbexText(68)
Me.Kno_VorschlagNein.Caption = AbexText(69)
Me.Kno_Nie.Caption = AbexText(70)
Me.Cancel_Optionen.Caption = AbexText(50)
Me.Kno_SpracheAuto.Caption = AbexText(24)
Me.Kno_SpracheD.Caption = AbexText(25)
Me.Kno_SpracheF.Caption = AbexText(26)
Me.Kno_SpracheE.Caption = AbexText(27)
Select Case System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "FrageninWinWord")
Case "0"
    Me.Kno_Nie.Value = True
Case "1"
    Me.Kno_VorschlagNein.Value = True
Case "2"
    Me.Kno_VorschlagJa.Value = True
Case Else
    Me.Kno_Immer.Value = True
End Select

Select Case System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "WinWordSprache")
Case "1"
    Me.Kno_SpracheD.Value = True
Case "2"
    Me.Kno_SpracheF.Value = True
Case "4"
    Me.Kno_SpracheE.Value = True
Case Else
    Me.Kno_SpracheAuto.Value = True
End Select
End Sub

Attribute VB_Name = "Macros"
Dim ProgSprache$
Dim Rec As Long
Public FldRef() As String
Public DokuRef() As String
Public ProjektRef() As String
Public AuftRef() As String
Public KopfRef() As String
Public PosRef() As String

Public AnzAdressFelder As Integer
Public AnzDokuFelder As Integer
Public AnzProjektFelder As Integer
Public AnzAuftFelder As Integer
Public AnzKopfFelder As Integer
Public AnzPosFelder As Integer
' --- Deklarationen für Winfax ---
Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128   ' Maintenance string for PSS usage.
End Type
#If Win64 Then
    Private Declare PtrSafe Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
    Private Declare PtrSafe Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Integer) As Integer
    Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
    Private Declare PtrSafe Function GetBoolRegVal Lib "WfxMacro.dll" (ByVal szSubkeyname As String, ByVal szValueName As String) As Integer
    Private Declare PtrSafe Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#Else
    Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
    Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Integer) As Integer
    Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
    Private Declare Function GetBoolRegVal Lib "WfxMacro.dll" (ByVal szSubkeyname As String, ByVal szValueName As String) As Integer
    Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
Public Sub AdressePositionieren()
' --- Positioniert im Programm Visual-Adress die Adresse gemäss RecID ---
On Local Error Resume Next
Dim ChanNum As Long
' --- Kanal initialisieren ---
ChanNum = DDEInitiate("VADRESS", "System")
If ChanNum <> 0 Then
    DDEExecute Channel:=ChanNum, Command:="GOTOADRRECID" + "499995097"  ' Firma HappyDor in Demodaten
    DDETerminate Channel:=ChanNum
End If
End Sub
Public Sub AutoOpen()
Attribute AutoOpen.VB_Description = "AutoOpen\r\nCopyright Abex Software AG, CH-8957-Spreitenbach"
Attribute AutoOpen.VB_ProcData.VB_Invoke_Func = "Abex.Macros.AutoOpen"
' 0=Nie, 1=Fragen(Nein), 2=Fragen(Ja), 3=Immer
Select Case System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Abex\Visual-Adress 5\UserSettings", "FrageninWinWord")
Case "0"

Case "1"
    If MsgBox(AbexText(65), vbDefaultButton2 + vbYesNo) = vbYes Then
        Call AbexInit
        For Each BM In ActiveDocument.Bookmarks
            If BM.Name = "VisualAdressCATtxt" Then
                Call DisplayDatenblatt
                Exit For
            End If
        Next BM
    End If
Case "2"
    If MsgBox(AbexText(65), vbDefaultButton1 + vbYesNo) = vbYes Then
        Call AbexInit
        For Each BM In ActiveDocument.Bookmarks
            If BM.Name = "VisualAdressCATtxt" Then
                Call DisplayDatenblatt
                Exit For
            End If
        Next BM
    End If
Case Else
    Call AbexInit
End Select

End Sub
Public Sub AutoNew()
Attribute AutoNew.VB_Description = "AutoNew\r\nCopyright Abex Software AG, CH-8957-Spreitenbach"
Attribute AutoNew.VB_ProcData.VB_Invoke_Func = "Abex.Macros.AutoNew"
Call AbexInit
End Sub
Public Sub AbexMenu()
Attribute AbexMenu.VB_Description = "Menu\r\nCopyright Abex Software AG, CH-8957-Spreitenbach"
Attribute AbexMenu.VB_ProcData.VB_Invoke_Func = "Abex.Macros.AbexMenu"
AbexFrmMenu.Show
End Sub
Public Sub AbexInit()
Attribute AbexInit.VB_Description = "Init\r\nCopyright Abex Software AG, CH-8957-Spreitenbach"
Attribute AbexInit.VB_ProcData.VB_Invoke_Func = "Abex.Macros.AbexInit"
On Local Error Resume Next
Dim BM As Bookmark
Dim Gefunden As Boolean
Gefunden = False
For Each BM In ActiveDocument.Bookmarks
    If BM.Name = "VisualAdressDDE" Then
        Call AbexKonvertToDDE
        Gefunden = True
        Exit For
    ElseIf BM.Name = "VisualAdressMail" Then
        AbexKonvertToMail
…

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