Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 aa3a1fe26a41f78b…

MALICIOUS

Office (OOXML)

4.69 MB Created: 2016-06-22 05:11:59 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2021-06-13
MD5: 958e6f382b0a7f5e714631210a29a397 SHA-1: 0d2df8f8df965b0f4f453020af4e3d1ed2ffaa6e SHA-256: aa3a1fe26a41f78bdfe3f031586c0daf90297d43b24070b47ecb5f9246cf5f71
214 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1219 Remote Access Software T1059 Command and Scripting Interpreter T1203 Exploitation for Client Execution

The sample is an Excel document containing a Workbook_Open VBA macro. This macro utilizes WScript.Shell and CreateObject to execute arbitrary code, strongly indicating its purpose is to download and execute a second-stage payload. The presence of multiple unknown URLs associated with 'alsgmbh.info' suggests these are likely C2 or download locations for the payload.

Heuristics 10

  • VBA project inside OOXML medium 5 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        If Val(Application.Version) > 9 Then
        Set objWSHShell = CreateObject("WScript.Shell")
        prcRead = objWSHShell.RegRead("HKCU\Software\Microsoft\Office\" & Application.Version & "\Excel\Security\AccessVBOM")
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
                Dim objFSO As Object
            Set objFSO = CreateObject("scripting.filesystemobject")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Sub Workbook_Open()
'Call AutoSpeichernEinschalten
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
    ''Stunden werden eingetragen, aber nur, wenn ich (Thomas Berger) den Konfi schließen
'If Environ("Username") = "thomas.berger" Then
'    GoTo weiter
  • Suspicious extracted artifact medium EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • External hyperlinks (2) low OOXML_EXTERNAL_HYPERLINKS
    Document contains 2 external hyperlinks — clickable URLs are stored as external relationships. First target: https://www.dehn.de/de/windlastzone
  • Hidden worksheet (hidden) low OOXML_HIDDEN_SHEET
    Excel workbook contains 20 hidden sheet(s) — hidden sheets are commonly used to conceal macro code, staging data, or intermediate payload construction
  • 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://www.alsgmbh.info/sites/default/files/Lamellenturmkonfigurator_LAS01_v14.xlsm Document hyperlink
    • http://www.alsgmbh.info/sites/default/files/Lamellenturmkonfigurator_LAS02_v14.xlsmDocument hyperlink
    • https://www.dehn.de/de/windlastzoneDocument hyperlink
    • http://www.als-gmbh.de/lueftungstuerme.htmlDocument hyperlink
    • http://www.alsgmbh.info/Document hyperlink
    • https://www.amev-online.de/AMEVInhalt/Planen/Maschinenbau-und-Versorgungstechnik/RLT - Anlagenbau 2018/RLT_2018-Stand_06_2018.pdfDocument hyperlink
    • https://www.amev-online.de/AMEVInhalt/Planen/Maschinenbau-und-Versorgungstechnik/RLTDocument hyperlink
    • http://als-gmbh.de/assets/Bedienungsanleitung_LTK.pdfDocument hyperlink
    • http://www.als-gmbh.de/sites/default/files/Bedienungsanleitung_LTK.pdfDocument hyperlink
    • http://ns.adobe.com/xap/1.0/In document text (OOXML body / shared strings)
    • http://www.w3.org/1999/02/22-rdf-syntax-ns#In document text (OOXML body / shared strings)
    • http://purl.org/dc/elements/1.1/In document text (OOXML body / shared strings)
    • http://ns.adobe.com/photoshop/1.0/In document text (OOXML body / shared strings)
    • http://ns.adobe.com/xap/1.0/mm/In document text (OOXML body / shared strings)
    • http://ns.adobe.com/xap/1.0/sType/ResourceEvent#In document text (OOXML body / shared strings)
    • http://www.iec.chIn document text (OOXML body / shared strings)

Extracted artifacts 32

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 313737 bytes
SHA-256: e0f6d5bbd972838bc299d65fb76d3be0e5e60820c0d51de02fe7cad477c14ef5
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "Tabelle1"
Attribute VB_Base = "0{00020820-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_Control = "CheckBox8, 24099, 4, MSForms, CheckBox"
Attribute VB_Control = "CheckBox5, 745, 5, MSForms, CheckBox"
Attribute VB_Control = "CheckBox3, 743, 6, MSForms, CheckBox"
Attribute VB_Control = "CheckBox2, 742, 7, MSForms, CheckBox"
Attribute VB_Control = "CheckBox1, 741, 8, MSForms, CheckBox"
Attribute VB_Control = "OptionButton15, 506, 9, MSForms, OptionButton"
Attribute VB_Control = "OptionButton109, 505, 10, MSForms, OptionButton"
Attribute VB_Control = "OptionButton108, 490, 11, MSForms, OptionButton"
Attribute VB_Control = "OptionButton12, 489, 12, MSForms, OptionButton"
Attribute VB_Control = "OptionButton11, 481, 13, MSForms, OptionButton"
Attribute VB_Control = "OptionButton10, 480, 14, MSForms, OptionButton"
Attribute VB_Control = "OptionButton9, 479, 15, MSForms, OptionButton"
Attribute VB_Control = "OptionButton107, 478, 16, MSForms, OptionButton"
Attribute VB_Control = "OptionButton7, 463, 17, MSForms, OptionButton"
Attribute VB_Control = "OptionButton6, 462, 18, MSForms, OptionButton"
Attribute VB_Control = "OptionButton100, 461, 19, MSForms, OptionButton"
Attribute VB_Control = "OptionButton110, 459, 20, MSForms, OptionButton"
Attribute VB_Control = "OptionButton3, 458, 21, MSForms, OptionButton"
Attribute VB_Control = "OptionButton2, 457, 22, MSForms, OptionButton"
Attribute VB_Control = "OptionButton111, 456, 23, MSForms, OptionButton"
Attribute VB_Control = "OptionButton101, 529, 24, MSForms, OptionButton"
Attribute VB_Control = "OptionButton17, 530, 25, MSForms, OptionButton"
Attribute VB_Control = "OptionButton18, 531, 26, MSForms, OptionButton"
Attribute VB_Control = "OptionButton19, 532, 27, MSForms, OptionButton"
Attribute VB_Control = "OptionButton102, 547, 28, MSForms, OptionButton"
Attribute VB_Control = "OptionButton21, 548, 29, MSForms, OptionButton"
Attribute VB_Control = "OptionButton22, 563, 30, MSForms, OptionButton"
Attribute VB_Control = "OptionButton23, 564, 31, MSForms, OptionButton"
Attribute VB_Control = "OptionButton103, 565, 32, MSForms, OptionButton"
Attribute VB_Control = "OptionButton104, 573, 33, MSForms, OptionButton"
Attribute VB_Control = "OptionButton26, 574, 34, MSForms, OptionButton"
Attribute VB_Control = "OptionButton27, 575, 35, MSForms, OptionButton"
Attribute VB_Control = "OptionButton105, 590, 36, MSForms, OptionButton"
Attribute VB_Control = "OptionButton29, 591, 37, MSForms, OptionButton"
Attribute VB_Control = "OptionButton106, 592, 38, MSForms, OptionButton"
Attribute VB_Control = "OptionButton31, 593, 39, MSForms, OptionButton"
Attribute VB_Control = "OptionButton32, 594, 40, MSForms, OptionButton"
Attribute VB_Control = "OptionButton33, 595, 41, MSForms, OptionButton"
Attribute VB_Control = "CheckBox6, 2966, 42, MSForms, CheckBox"
Attribute VB_Control = "OptionButton1, 41447, 43, MSForms, OptionButton"
Attribute VB_Control = "Label1, 43543, 44, MSForms, Label"
Attribute VB_Control = "Label2, 43552, 45, MSForms, Label"
Attribute VB_Control = "CheckBox4, 44489, 46, MSForms, CheckBox"
Attribute VB_Control = "CommandButton1, 44490, 47, MSForms, CommandButton"
'Private Sub CheckBox9_Click()
''Fußbereich im Erdreich
'If Sheets("Tabelle1").CheckBox9.Value = False Then
'    Range("V22").Value = 0
'End If
'If Sheets("Tabelle1").CheckBox9.Value = True Then
'    Range("W22").Select
'End If
'
'End Sub

Private Sub CheckBox4_Click()
    If Sheets("Tabelle1").CheckBox4.Value = True Then
        If Sheets("Auswertung").Range("B23").Value = 1 Then
            Sheets("Berechnung bündige Lamellen").CheckBox1.Value = True
        Else
            Sheets("Berechnung FO-über_ohne_Schatte").CheckBox1.Value = True
        End If
    Else
        If Sheets("Auswertung").Range("B23").Value = 1 Then
            Sheets("Berechnung bündige Lamellen").CheckBox1.Value = False
        Else
            Sheets("Berechnung FO-über_ohne_Schatte").CheckBox1.Value = False
        End If
    End If
    
End Sub

Private Sub CommandButton1_Click()
a = MsgBox("Als Standardausführung wird bei einem Lüftungsturm aus Edelstahl die Bodenplatte " & _
        "aus S235JR gefertigt und anschließend lackiert." & vbCrLf & _
        "Alternativ kann jedoch auch die Bodenplatte aus dem selben Edelstahl wie der Turm gefertigt werden.", , "Bodenplatte aus Edelstahl")
        
End Sub

Private Sub Label2_Click()

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'==============================================================================================
'wenn eine Tiefe für das Erdreich eingestellt wurde, wird das Feld automatisch selbst ausgewählt
'===============================================================================================

'If ActiveCell.Address <> "$W$22" Then
'    If Range("V22").Value = 0 Then
'        Sheets("Tabelle1").CheckBox9.Value = False
'    End If
'End If
'If Range("V22").Value <> 0 Then
'    Sheets("Tabelle1").CheckBox9.Value = True
'End If
'If Sheets("Tabelle1").CheckBox9.Value = False Then
'    Range("V22").Value = 0
'End If
'
'If Range("V24").Value <> 0 Then
'    Sheets("Tabelle1").CheckBox4.Value = True
'End If
'If Sheets("Tabelle1").CheckBox4.Value = False Then
'    Range("V24").Value = 0
'End If

'If Range("V22") = 0 And Sheets("Tabelle1").CheckBox9.Value = True Then
'    MsgBox "Bitte die Erdreich-Tiefe eingeben."
'End If
'
'If Range("V24").Value = 0 And Sheets("Tabelle1").CheckBox4.Value = True Then
'    MsgBox "Bitte die Höhe des Anstrichs eingeben."
'End If

End Sub


Attribute VB_Name = "Tabelle21"
Attribute VB_Base = "0{00020820-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 = "Tabelle10"
Attribute VB_Base = "0{00020820-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 = "Tabelle3"
Attribute VB_Base = "0{00020820-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 = "Tabelle4"
Attribute VB_Base = "0{00020820-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 = "Tabelle5"
Attribute VB_Base = "0{00020820-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 = "Tabelle6"
Attribute VB_Base = "0{00020820-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 = "Tabelle7"
Attribute VB_Base = "0{00020820-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 = "Tabelle8"
Attribute VB_Base = "0{00020820-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 = "Tabelle9"
Attribute VB_Base = "0{00020820-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 = "DieseArbeitsmappe"
Attribute VB_Base = "0{00020819-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
'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'
'Call AutoSpeichernAusschalten
'
''Sub öaldkfj()
''Stunden werden eingetragen, aber nur, wenn ich (Thomas Berger) den Konfi schließen
'If Environ("Username") = "thomas.berger" Then
'    GoTo weiter
'Else
'    If Environ("Username") = "thomas.berger.LLS" Then
'        GoTo weiter
'    Else
'        If Environ("Username") = "Thomas" Then
'            GoTo weiter
'        Else
'            Exit Sub
'        End If
'    End If
'End If
'weiter:
'letztezeileA = Sheets("Stundenabrechnung").Cells(1048576, 1).End(xlUp).Row
'Sheets("Stundenabrechnung").Cells(letztezeileA, 4).Value = Format(Now, "HH" & ":" & "mm" & ":" & "ss")
'
'If Environ("username") = "thomas.berger" Then
'    ActiveWorkbook.Save
'End If
'
'End Sub
Sub aöldkfj()
If Dir(laufwerk & "ALS\Stundenübersicht\", vbDirectory) <> "" Then
    If Environ("Username") = "Thomas" Or Environ("Username") = "thomas.berger" Or Environ("Username") = "th29b" Then
        If Dir(Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 30) & "\Versionspeichern\Lueftungsturmkonfigurator_" & Replace(ThisWorkbook.Sheets("Deckblatt").Range("F2").Value, ".", "_") & ".xlsm") = "" Then
            Dim objFSO As Object
            Set objFSO = CreateObject("scripting.filesystemobject")
                
        End If
    End
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'wenn aufgrund des Makros "erstes_oeffnen" gespeichert wird, dann soll die Formel im LV-Text bestehen bleiben und als konstanter Wert gesetzt werden
    If erstes_öffnen = False Then
        'Damit immer nachvollzogen werden kann, wann der LV-Text zuletzt bearbeitet wurde
        Sheets("LV-TExt").Range("C16").Value = Date
    End If
End Sub

Sub Workbook_Open()
'Call AutoSpeichernEinschalten

If Application.ScreenUpdating = True Then
    Application.ScreenUpdating = False
    appScUp = 1
End If
'Button zur Datenübertragung und Kalkulation in neue Excelmappe wird eingeblendet,
'wenn bestimmter Pfad existiert
Dim name2 As String
Dim laufwerk As String

'Laufwerke überprüfen
On Error Resume Next

'überspringt gesperrte Laufwerke
For i = 3 To 20
Buchstabe = Chr(64 + i)
    ordner = Buchstabe & ":\ALS\Stundenübersicht\"
    If Dir(ordner) = "" Then
        GoTo ende0
    Else
        laufwerk = Buchstabe & ":\"
        'MsgBox laufwerk
        GoTo ende1
    End If
ende0:
Next i
ende1:

Sheets("Deckblatt").Range("B9").Select

If Dir(laufwerk & "ALS\Stundenübersicht\", vbDirectory) <> "" Then
    ActiveSheet.Shapes.Range(Array("Datenübertragung")).Visible = msoTrue
    ActiveSheet.Shapes.Range(Array("Kalkulation")).Visible = msoTrue
Else
    If Dir("H:\Technik\Zeichnungen\", vbDirectory) = "" Then
        ActiveSheet.Shapes.Range(Array("Datenübertragung")).Visible = msoFalse
        ActiveSheet.Shapes.Range(Array("Kalkulation")).Visible = msoFalse
    Else
        ActiveSheet.Shapes.Range(Array("Datenübertragung")).Visible = msoTrue
        ActiveSheet.Shapes.Range(Array("Kalkulation")).Visible = msoTrue
    End If
End If

If Dir(laufwerk & "ALS\Stundenübersicht\", vbDirectory) <> "" Then
    If Environ("Username") = "Thomas" Or Environ("Username") = "thomas.berger" Or Environ("Username") = "th29b" Then
        ActiveSheet.Shapes.Range(Array("Email_Franz")).Visible = msoTrue
    Else
        GoTo ausblenden
    End If
Else
ausblenden:
    ActiveSheet.Shapes.Range(Array("Email_Franz")).Visible = msoFalse
End If
        
''Übersicht, wie viele Stunden in diese Excel-Datei investiert wurden, ab dem 17.08.2017
'If Environ("Username") = "thomas.berger" Or Environ("Username") = "Thomas" Then
'    letztezeileA = Sheets("Stundenabrechnung").Cells(1048576, 1).End(xlUp).Row
'    Sheets("Stundenabrechnung").Cells(letztezeileA + 1, 1).Value = Environ("Username")
'    Sheets("Stundenabrechnung").Cells(letztezeileA + 1, 2).Value = Date
'    Sheets("Stundenabrechnung").Cells(letztezeileA + 1, 3).Value = Format(Now, "HH" & ":" & "mm" & ":" & "ss")
'Else
'    Exit Sub
'End If

''Deckblatt wird angezeigt, macht eig. keinen Sinn mehr, wenn beim abspeichern der online-version das deckblatt ausgewählt wurde
'Sheets("deckblatt").Activate

If appScUp = 1 Then
    Application.ScreenUpdating = True
End If

End Sub


Attribute VB_Name = "Tabelle16"
Attribute VB_Base = "0{00020820-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 = "Tabelle12"
Attribute VB_Base = "0{00020820-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 = "Modul1"
'erstellt von thomas.berger/laszlo.jadi

' AppScUp = Application.ScreenUpdating, überpüfen ob dies aktiv ist oder nicht

Sub deckblatt()


If Application.ScreenUpdating = True Then
    Application.ScreenUpdating = False
    appScUp = 1
End If

On Error GoTo Fehler
Sheets("Deckblatt").Activate
Range("B9").Select

If appScUp = 1 Then
    Application.ScreenUpdating = True
End If

Exit Sub
Fehler:
    Feco = "M1-01"  'Fehlercode
    MsgBox "Es ist ein Fehler aufgetreten." & vbCrLf & _
            "Bitte versuchen Sie es erneut oder kontaktieren Sie" & vbCrLf & _
            "uns persönlich unter Tel. 08082/ 937-0 oder auch gerne " & vbCrLf & _
            "per Email info@als-kd.de" & vbCrLf & _
            "Vielen Dank für Ihr Verständnis"
End Sub
Sub konfi()

pword = Sheets("Auswertung").Range("H7").Value
     

On Error GoTo Fehler

If Application.ScreenUpdating = True Then
    Application.ScreenUpdating = False
    appScUp = 1
End If

'Laufwerke überprüfen
On Error Resume Next

'überspringt gesperrte Laufwerke
For i = 3 To 20
Buchstabe = Chr(64 + i)
    ordner = Buchstabe & ":\ALS\Stundenübersicht\"
    If Dir(ordner) = "" Then
        GoTo ende0
    Else
        laufwerk = Buchstabe & ":\"
        'MsgBox laufwerk
        GoTo ende1
    End If
ende0:
Next i
ende1:

On Error GoTo Fehler
On Error GoTo 0
Sheets("Tabelle1").Unprotect Password:=pword

strTabName = ActiveSheet.Name

    If strTabName = "Berechnung FO-über_ohne_Schatte" Then
        If Sheets("Auswertung").Range("B66").Value = 1 Then
            If Sheets("Berechnung FO-über_ohne_Schatte").Range("F13").Value <= 415 Then
                If Sheets("Berechnung FO-über_ohne_Schatte").Range("F19").Value < Sheets("Berechnung FO-über_ohne_Schatte").Range("CJ17").Value Then GoTo text
            Else
                If Sheets("Berechnung FO-über_ohne_Schatte").Range("F13").Value <= 700 Then
                    If Sheets("Berechnung FO-über_ohne_Schatte").Range("F19").Value < Sheets("Berechnung FO-über_ohne_Schatte").Range("BI17").Value Then GoTo text
                Else
                    If Sheets("Berechnung FO-über_ohne_Schatte").Range("F19").Value < Sheets("Berechnung FO-über_ohne_Schatte").Range("AM17").Value Then GoTo text
                End If
            End If
        End If
        'wenn bodenplatte aus edelstahl auf Berechnungsseite ausgewählt wurde (evtl auch erst auf dieser seite), dann muss es auch auf der Konfi-seite ausgewählt sein
        If Sheets("Auswertung").Range("I35").Value = 1 Then
            Sheets("Tabelle1").CheckBox4.Value = True
        Else
            Sheets("Tabelle1").CheckBox4.Value = False
        End If
    End If
    
    If strTabName = "Berechnung bündige Lamellen" Then
        If Sheets("Auswertung").Range("B66").Value = 1 Then
            If Sheets("Berechnung bündige Lamellen").Range("F12").Value <= 415 Then
                If Sheets("Berechnung bündige Lamellen").Range("F18").Value < Sheets("Berechnung bündige Lamellen").Range("BX16").Value Then GoTo text
            Else
                If Sheets("Berechnung bündige Lamellen").Range("F12").Value <= 700 Then
                    If Sheets("Berechnung bündige Lamellen").Range("F18").Value < Sheets("Berechnung bündige Lamellen").Range("BB16").Value Then GoTo text
                Else
                    If Sheets("Berechnung bündige Lamellen").Range("F18").Value < Sheets("Berechnung bündige Lamellen").Range("AF16").Value Then GoTo text
                End If
            End If
        End If
        'wenn bodenplatte aus edelstahl auf Berechnungsseite ausgewählt wurde (evtl auch erst auf dieser seite), dann muss es auch auf der Konfi-seite ausgewählt sein
        If Sheets("Auswertung").Range("I34").Value = 1 Then
            Sheets("Tabelle1").CheckBox4.Value = True
        Else
            Sheets("Tabelle1").CheckBox4.Value = False
        End If
    End If
         
            
    If 2 = 1 Then 'diese If-Funktion verhindert nur, dass die MsgBox im normalen Verlauf verwendet wird
text:
        MsgBox "Bitte erhöhen Sie die Rohrhöhe oder verkürzen Sie den Schalldämpfer," & vbCrLf & _
               "bevor Sie fortfahren können."
        GoTo ende
    End If



    If Sheets("Deckblatt").Range("B9").Value = "" Or Sheets("Deckblatt").Range("B12").Value = "" Or Sheets("Deckblatt").Range("B16").Value = "" Or Sheets("Deckblatt").Range("B19").Value = "" Or Sheets("Deckblatt").Range("C19").Value = "" Then 'überprüfen ob Daten vollständig sind
        On Error Resume Next
        If Dir(laufwerk & "ALS\Stundenübersicht\", vbDirectory) <> "" Then
        Else
            If Dir("H:\Technik\Zeichnungen\", vbDirectory) = "" Then
                On Error GoTo Fehler
                mldg = "Der Konfigurator kann nicht optimal ausgeführt werden," & vbCrLf & _
                "wenn nicht alle erforderlichen Daten eingegeben wurden." & vbCrLf & vbCrLf & _
                "Möchten Sie dennoch fortfahren?"
                titel = ""
                stil = vbYesNo + vbDefaultButton1
                antwort = MsgBox(mldg, stil, titel)
                If antwort = vbYes Then
                    'Sheets("Auswertung").Range("R20").Value = "ja"
                    If ActiveSheet.Name = "Tabelle1" Then
                        Sheets("Deckblatt").Select
                        Sheets("Tabelle1").Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=pword
                        Range("D4").Select
                    Else
                        Sheets("Tabelle1").Select
                        Sheets("Tabelle1").Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=pword
                        Range("D4").Select
                    End If
                    GoTo ende
                Else
                    GoTo ende
                End If
            End If
        End If
    End If
    On Error GoTo Fehler
weiter:
            Sheets("Auswertung").Range("R20").Value = "ja"
            Sheets("Tabelle1").Activate
            Range("D4").Select

    
'Format für PLZ in das Feld für das Bauvorhaben übertragen
Sheets("Tabelle1").Range("D4").FormulaR1C1 = "=IF(Deckblatt!R[12]C[-2]="""","""",Deckblatt!R[12]C[-2] & "" - "" & TEXT(Deckblatt!R[15]C[-2]," & _
                                             Chr(34) & CStr(Application.WorksheetFunction.VLookup(Sheets("Deckblatt").CommandButton1.Caption, _
                                            Sheets("Auswertung").Range("B94:C105"), 2, 0)) & Chr(34) & ")& "" "" & Deckblatt!R[15]C[-1])"

ende:


Sheets("Tabelle1").Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=pword


If appScUp = 1 Then
    Application.ScreenUpdating = True
End If

Exit Sub
Fehler:
    MsgBox "Es ist ein Fehler aufgetreten." & vbCrLf & _
            "Bitte versuchen Sie es erneut oder kontaktieren Sie" & vbCrLf & _
            "uns persönlich unter Tel. 08082/ 937-0 oder auch gerne " & vbCrLf & _
            "per Email info@als-kd.de" & vbCrLf & _
            "Vielen Dank für Ihr Verständnis"
Sheets("Tabelle1").Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=pword


End Sub
Sub aösdlfj()

Sheets("Tabelle1").Range("D4").FormulaR1C1 = "=IF(Deckblatt!R[12]C[-2]="""","""",Deckblatt!R[12]C[-2] & "" - "" & TEXT(Deckblatt!R[15]C[-2]," & _
                                             Chr(34) & CStr(Application.WorksheetFunction.VLookup(Sheets("Deckblatt").CommandButton1.Caption, _
                                            Sheets("Auswertung").Range("B94:C105"), 2, 0)) & Chr(34) & ")& "" "" & Deckblatt!R[15]C[-1])"

End Sub


Sub ausleg_oeffnen()
'Auslegungsprogramm spezifisch öffnen

pword = Sheets("Auswertung").Range("H7").Value

'On Error GoTo Fehler

If Application.ScreenUpdating = True Then
    Application.ScreenUpdating = False
    appScUp = 1
End If


If ActiveSheet.Name = "Tabelle1" And Sheets("Auswertung").Range("R20").Value = "nein" Then
    mldg = "Sie haben auf dem Deckblatt nicht alle Daten vollständig eingegeben." & vbCrLf & _
            "Der LV-Text kann somit nicht richtig erstellt werden." & vbCrLf & vbCrLf & _
            "Möchten Sie zum Deckblatt zurück kehren?"
    titel = ""
    stil = vbYesNo + vbDefaultButton1
    antwort = MsgBox(mldg, stil, titel)
    If antwort = vbYes Then
        Sheets("Deckblatt").Select
        Range("B9").Select
    End If
    Exit Sub
Else
    If Sheets("Auswertung").Range("R20").Value = "nein" Then                                                'wurden in den Konfigurator die Daten schon eingegeben?
        mldg = "Bitte geben Sie zuerst ihre Daten in den Konfigurator ein, " & vbCrLf _
             & "damit für Sie das richtige Auslegungsprogramm ausgewählt werden kann." & vbCrLf & vbCrLf _
             & "Soll der Konfigurator geöffnet werden?"
        titel = ""
        stil = vbYesNo + vbDefaultButton1
        antwort = MsgBox(mldg, stil, titel)
        If antwort = vbYes Then
            Call konfi
        End If
        Exit Sub
    End If
If Sheets("Auswertung").Range("L14").Value = "Kombination nicht sinnvoll" Then
    MsgBox "Bei diesem Lüftungsturm handelt es sich um einen Turm, dessen Ausführung" & vbCrLf & _
            "entweder für die Luftführung nicht möglich ist" & vbCrLf & _
            "oder dieser Turm ist nicht in unserem Standardprogramm enthalten." & vbCrLf & _
            "Bitte wenden Sie sich dazu an Ihren untenstehenden als-kd Ansprechpartner." & vbCrLf & _
            "Vielen Dank!"
    Exit Sub
End If

    'überprüfen, ob bei Fußbereich im Erdreich eine Höhe eingegeben wurde
    If Sheets("Auswertung").Range("G51").Value = True And Sheets("Tabelle1").Range("V22").Value = 0 Then
            MsgBox "Bitte geben Sie die Höhe ein, bis zu der " & vbCrLf & _
                    "der Fußbereich im Erdreich verbaut ist."
            Sheets("Tabelle1").Range("V22").Select
            GoTo ende1
    End If

    'überprüfen, ob bei Fußbereich im Erdreich eine Höhe eingegeben wurde
    If Sheets("Auswertung").Range("A67").Value = True And Sheets("Tabelle1").Range("V24").Value = 0 Then
            MsgBox "Bitte geben Sie die Höhe ein, bis zu der " & vbCrLf & _
                    "der Bitumenschutzanstrich außen gebracht wird."
            Sheets("Tabelle1").Range("V24").Select
            GoTo ende1
    End If

    If TLD = 111 Or TLD = 112 _
    Or TLD = 211 Or TLD = 212 Then
        Call ausleg_bündig
    Else
        Call ausleg_über_ohne_Schatten
    End If
End If
    Sheets("Auswertung").Range("R22").Value = "ja" 'bestätigt das Öffnen des Auslegungsprogramms
    
    
'Nicht-Berücksichtigung bei der lufttechnischen Berechnung
    'GRK
If Sheets("Auswertung").Range("B31").Value = "2" Then
   MsgBox "Druckverluste der Geschwindigkeitsregelklappe werden" & vbCrLf & _
            "bei der Berechnung nicht berücksichtigt" & vbCrLf & _
            "Für genauere Werte wenden Sie sich bitte persönlich an uns." & vbCrLf & _
            "Vielen Dank.", vbOKOnly, "Hinweis"
End If



'With Sheets("Auswertung")
'   ' If .Range("B42").Value = 2 Or .Range("B64").Value = 1 Or .Range("B66").Value = 1 Then
'   '    MsgBox "Achtung, das ausgewählte Zubehör ist bei der" & vbCrLf & _
'   '            "lufttechnischen Berechnung nicht berücksichtigt."
'   zb = .Range("b64").Value * 10 + .Range("b66").Value: zbt = ""
'   If zb > 0 Then
'       If zb = 10 Then zbt = "Luftfilter"
'       If zb = 1 Then zbt = "Schalldämpfer"
'       If zb = 11 Then zbt = "Luftfilter und Schalldämpfer"
'       MsgBox "Achtung, das ausgewählte Zubehör (" & zbt & ") ist bei der" & vbCrLf & _
'                   "lufttechnischen Berechnung nicht berücksichtigt."
'   End If
'End With

ende1:

If appScUp = 1 Then
    Application.ScreenUpdating = True
End If

Exit Sub

Fehler:
    MsgBox "Es ist ein Fehler aufgetreten." & vbCrLf & _
            "Bitte versuchen Sie es erneut oder kontaktieren Sie" & vbCrLf & _
            "uns persönlich unter Tel. 08082/ 937-0 oder auch gerne " & vbCrLf & _
            "per Email info@als-kd.de" & vbCrLf & _
            "Vielen Dank für Ihr Verständnis"

End Sub
Sub LV_Text()
' LV_Text erstellen

pword = Sheets("Auswertung").Range("H7").Value

On Error GoTo Fehler

If Application.ScreenUpdating = True Then
    Application.ScreenUpdating = False
    appScUp = 1
End If


Sheets("LV-Text").Unprotect Password:=pword

strTabName = ActiveSheet.Name

    If strTabName = "Berechnung FO-über_ohne_Schatte" Then
        If Sheets("Auswertung").Range("B66").Value = 1 Then
            If Sheets("Berechnung FO-über_ohne_Schatte").Range("F13").Value <= 415 Then
                If Sheets("Berechnung FO-über_ohne_Schatte").Range("F19").Value < Sheets("Berechnung FO-über_ohne_Schatte").Range("CJ17").Value Then GoTo text
            Else
                If Sheets("Berechnung FO-über_ohne_Schatte").Range("F13").Value <= 700 Then
                    If Sheets("Berechnung FO-über_ohne_Schatte").Range("F19").Value < Sheets("Berechnung FO-über_ohne_Schatte").Range("BI17").Value Then GoTo text
                Else
                    If Sheets("Berechnung FO-über_ohne_Schatte").Range("F19").Value < Sheets("Berechnung FO-über_ohne_Schatte").Range("AM17").Value Then GoTo text
                End If
            End If
        End If
    End If
    
    If strTabName = "Berechnung bündige Lamellen" Then
        If Sheets("Auswertung").Range("B66").Value = 1 Then
            If Sheets("Berechnung bündige Lamellen").Range("F12").Value <= 415 Then
                If Sheets("Berechnung bündige Lamellen").Range("F18").Value < Sheets("Berechnung bündige Lamellen").Range("BX16").Value Then GoTo text
            Else
                If Sheets("Berechnung bündige Lamellen").Range("F12").Value <= 700 Then
                    If Sheets("Berechnung bündige Lamellen").Range("F18").Value < Sheets("Berechnung bündige Lamellen").Range("BB16").Value Then GoTo text
                Else
                    If Sheets("Berechnung bündige Lamellen").Range("F18").Value < Sheets("Berechnung bündige Lamellen").Range("AF16").Value Then GoTo text
                End If
            End If
        End If
    End If
         
            
    If 2 = 1 Then  'diese If-Funktion verhindert nur, dass die MsgBox im normalen Verlauf verwendet wird
text:
        MsgBox "Bitte erhöhen Sie die Rohrhöhe oder verkürzen Sie den Schalldämpfer," & vbCrLf & _
               "bevor Sie fortfahren können."
        GoTo ende
    End If


If Sheets("Auswertung").Range("L14").Value = "Kombination nicht sinnvoll" Then
    MsgBox "Bei diesem Lüftungsturm handelt es sich um einen Turm, dessen Ausführung" & vbCrLf & _
            "entweder für die Luftführung nicht möglich ist" & vbCrLf & _
            "oder dieser Turm ist nicht in unserem Standardprogramm enthalten." & vbCrLf & _
            "Bitte wenden Sie sich dazu an Ihren untenstehenden als-kd Ansprechpartner." & vbCrLf & _
            "Vielen Dank!"
    Sheets("LV-Text").Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=pword
    Exit Sub
End If

    If Sheets("Auswertung").Range("R22").Value = "nein" Then
        mldg = "Bitte geben Sie zuerst ihre Daten in den Auslegungsprogramm ein," & vbCrLf & _
                "damit der LV-Text richtig erstellt werden kann." & vbCrLf & vbCrLf & _
                "Soll das Auslegungsprogramm geöffnet werden?"
        titel = ""
        stil = vbYesNo + vbDefaultButton1
        antwort = MsgBox(mldg, stil, titel)
        If antwort = vbYes Then
            Call ausleg_oeffnen
            Sheets("LV-Text").Select
            Call Deckblatt_ausblenden
            Application.ScreenUpdating = False
            Range("A6").Select
        End If
        Sheets("LV-Text").Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=pword
        Exit Sub
    End If
 
    Sheets("Auswertung").Range("R24").Value = "ja" 'bestätigt das Öffnen des LV-Textes
    
    'beim ersten Öffnen des LV-Textes wird in der Zelle des Datums die Formel durch einen festen Wert ersetzt
    If Sheets("LV-TExt").Range("C16").HasFormula Then
        Sheets("LV-TExt").Range("C16").Value = Date
    End If
    
    'schreibt auf erste Seite, ob Fort- oder Außenluftturm
    If Sheets("auswertung").Range("B10").Value = "1" Then
        Sheets("LV-Text").Range("A46").Value = "Bauseitige Leistungen für Fortlufttürme"
    Else
        Sheets("LV-Text").Range("A46").Value = "Bauseitige Leistungen für Außenlufttürme"
    End If
    
        
    
    Sheets("LV-Text").Select
    
    Call Deckblatt_ausblenden
    Application.ScreenUpdating = False
    Sheets("LV-Text").Unprotect Password:=pword
    
    'wenn weder ein Holzverschlag noch eine Arbeitsbühne verwendet wird, dann muss die Pos.7 ausgeblendet werden
    If Sheets("Auswertung").Range("B23").Value = 1 Then
        If Sheets("Berechnung bündige Lamellen").Range("F24").Value < 5001 And Sheets("Berechnung bündige Lamellen").Range("F24").Value > 4000 Then
            Sheets("LV-Text").Rows("176:179").Hidden = True
            Sheets("LV-Text").Rows("94:175").EntireRow.AutoFit
        Else
            Sheets("LV-Text").Rows("176:179").Hidden = False
            Sheets("LV-Text").Rows("94:179").EntireRow.AutoFit
        End If
    Else
        If Sheets("Berechnung FO-über_ohne_Schatte").Range("F27").Value < 5001 And Sheets("Berechnung FO-über_ohne_Schatte").Range("F27").Value > 4000 Then
            Sheets("LV-Text").Rows("176:179").Hidden = True
            Sheets("LV-Text").Rows("94:175").EntireRow.AutoFit
        Else
            Sheets("LV-Text").Rows("176:179").Hidden = False
            Sheets("LV-Text").Rows("94:179").EntireRow.AutoFit
        End If
    End If
    
    If Sheets("Auswertung").Range("B10").Value = 1 Then
        Sheets("LV-Text").Range("B108").Value = "Fortluftturm " & Sheets("Tabelle1").Shapes.Range(Array("TextBox 2")).TextFrame2.TextRange.Characters.text
    Else
        Sheets("LV-Text").Range("B108").Value = "Außenluftturm " & Sheets("Tabelle1").Shapes.Range(Array("TextBox 2")).TextFrame2.TextRange.Characters.text
    End If
    
    Range("A6").Select
    
    
''Überprüfen,ob Gesamtlänge >5m oder Wandhalterung, ob Arbeitsbühne zur Montage notwendig
'If Sheets("Auswertung").Range("B23").Value = "1" Then
'    If Sheets("Berechnung bündige Lamellen").Range("F24").Value > 5000 Or Sheets("Auswertung").Range("B69").Value = "1" Then
'        Rows("181:183").Rows.Hidden = False
'    Else
'        Rows("181:183").Rows.Hidden = True
'    End If
'Else
'    If Sheets("Berechnung FO-über_ohne_Schatte").Range("F27").Value > 5000 Or Sheets("Auswertung").Range("B69").Value = "1" Then
'        Rows("181:183").Rows.Hidden = False
'    Else
'        Rows("181:183").Rows.Hidden = True
'    End If
'End If



'Pos. 7
    'Rows("177:178").EntireRow.AutoFit


Sheets("LV-Text").Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=pword
    
If appScUp = 1 Then
    Application.ScreenUpdating = True
End If

ende:


Exit Sub
Fehler:
    MsgBox "Es ist ein Fehler aufgetreten." & vbCrLf & _
            "Bitte versuchen Sie es erneut oder kontaktieren Sie" & vbCrLf & _
            "uns persönlich unter Tel. 08082/ 937-0 oder auch gerne " & vbCrLf & _
            "per Email info@als-kd.de" & vbCrLf & _
            "Vielen Dank für Ihr Verständnis"
    Sheets("LV-Text").Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=pword

End Sub


'============================================================================================================================================
'Fundamentlast-Seite öffnen
'============================================================================================================================================
Sub Fundamentlast_oeffnen()

pword = Sheets("Auswertung").Range("H7").Value


If Application.ScreenUpdating = True Then
    Application.ScreenUpdating = False
    appScUp = 1
End If


If Sheets("Auswertung").Range("D23").Value = "bündig" Then
    dm = Sheets("Berechnung bündige Lamellen").Range("F12")
Else
    dm = Sheets("Berechnung FO-über_ohne_Schatte").Range("F13").Value
End If

If Sheets("auswertung").Range("A69") = True Then
    MsgBox "Die Fundamentlastberechnung erfolgt nur für freistehende Türme." & vbCrLf & _
            "Für Tragrohre mit Wandangebindung wenden Sie sich bitte an" & vbCrLf & _
            "uns unter Tel.: 08082/937-0 oder auch gerne" & vbCrLf & _
            "per Mail an info@als-kd.de" & vbCrLf & _
            "Vielen Dank"
    Exit Sub
End If

If dm > 2500 Then
    MsgBox "Die Berechnung der Fundamentlasten kann hier" & vbCrLf & _
            "nur bis Durchmesser Ø 2500 durchgeführt werden." & vbCrLf & _
            "Bei größeren Durchmessern wenden Sie sich bitte direkt an uns " & vbCrLf & _
            "unter der Tel.: 08082/937-0 oder auch " & vbCrLf & _
            "gerne per Mail an info@als-kd.de" & vbCrLf & _
            "Vielen Dank"
    Exit Sub
Else
    Sheets("Fundamentlasten").Unprotect Password:=pword
    
    If Sheets("deckblatt").Range("b22").Value > 1 Then
        Sheets("fundamentlasten").OptionButton1.Value = True
    Else
        Sheets("fundamentlasten").OptionButton2.Value = True
    End If
   
    'Text Positionsnummer übernehmen
    Sheets("Fundamentlasten").Range("F2").Value = Sheets("Tabelle1").Shapes.Range(Array("TextBox 2")).TextFrame2.TextRange.Characters.text
    
    Sheets("Fundamentlasten").Range("G13").Value = dm
    If Sheets("Auswertung").Range("D23").Value = "bündig" Then
        Sheets("Fundamentlasten").Range("G15").Value = Sheets("Berechnung bündige Lamellen").Range("F24")
    Else
        Sheets("Fundamentlasten").Range("G15").Value = Sheets("Berechnung FO-über_ohne_Schatte").Range("F27").Value
    End If
    Sheets("Fundamentlasten").Range("G17").Value = Sheets("deckblatt").Range("B22").Value
    Sheets("Fundamentlasten").Activate
    Sheets("Fundamentlasten").Range("E13").Activate
    
    Sheets("Fundamentlasten").Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=pword
End If
    
    Sheets("fundamentlasten").Range("E13").Select
    
If appScUp = 1 Then
    Application.ScreenUpdating = True
End If
    
    

End Sub


Sub Excel_Workbook_via_Outlook_Senden()
    Dim MyMessage As Object, MyOutApp As Object
    Dim Qe As Integer
    Dim AWS As String
    
On Error GoTo Fehler

pword = Sheets("Auswertung").Range("H7").Value

If Sheets("Auswertung").Range("L14").Value = "Kombination nicht sinnvoll" Then
    MsgBox "Bei diesem Lüftungsturm handelt es sich um einen Turm, dessen Ausführung" & vbCrLf & _
            "entweder für die Luftführung nicht möglich ist" & vbCrLf & _
            "oder dieser Turm ist nicht in unserem Standardprogramm enthalten." & vbCrLf & _
            "Bitte wenden Sie sich dazu an Ihren untenstehenden als-kd Ansprechpartner." & vbCrLf & _
            "Vielen Dank!"
Exit Sub
End If


If Sheets("Auswertung").Range("R24").Value = "nein" Then 'LV-Text wurde noch nicht geöffnet
    mldg = "Bitte geben Sie zuerst ihre Daten in den LV-Text ein," & vbCrLf & _
           "damit Ihre Anfrage gemäß Ihrer Auswahl bearbeitet werden kann." & vbCrLf & vbCrLf & _
            "Soll der LV-Text geöffnet werden?"
    titel = ""
    stil = vbYesNo + vbDefaultButton1
    antwort = MsgBox(mldg, stil, titel)
    If antwort = vbYes Then
        Call LV_Text
        Exit Sub
    End If
' Else
'    If Sheets("LV-Text").Range("A6").Value = Sheets("Deckblatt").Range("B9").Value Then
'        mldg = "Sie haben noch keine vollständige Adresse des Planers eingegeben." & vbCrLf & vbCrLf & _
'               "Möchten Sie dennoch die Anfrage starten?"
'        Titel = ""
'        Stil = vbYesNo + vbDefaultButton1
'        Antwort = MsgBox(mldg, Stil, Titel)
'        If Antwort = vbYes Then
'            GoTo email
'        End If
'        Exit Sub
'     End If
End If
        

email:


    'Testen ob die aktuelle Mappe schon gespeichert wurde
    If ThisWorkbook.Saved = False Then
        'Die letzten Änderungen wurden noch nicht gespeichert
        Qe = MsgBox("Diese Mappe wurde noch nicht gespeichert, und kann nicht versandt werden!" _
        & Chr$(13) & "Soll die Datei gespeichert werden?", vbInformation + vbYesNo, "Sendefehler")
        If Qe = vbNo Then
            'Abbruch durch Benutzer
            MsgBox "Sendevorgang abgebrochen"
            Exit Sub
        Else
            'Prüfen ob die Datei schon mal gespeichert wurde
            If Right(ThisWorkbook.Name, 4) <> "xls" Then
                'Nein > Speicherdialog aufrufen
                Application.Dialogs(xlDialogSaveAs).Show
            Else
                'Speichern
                ThisWorkbook.Save
            End If
        End If
    End If
    'Aktive Arbeitsmappe wird als mail gesendet
    'Übergabe des Mappennames an die Variable
    AWS = ThisWorkbook.FullName
    'Outlook Object erstellen
    Set MyOutApp = CreateObject("Outlook.Application")
    'Outlook Nachricht erstellen
    Set MyMessage = MyOutApp.CreateItem(0)
    With MyMessage
        'Empfänger
        .To = "info@als-kd.de"
        'Betreff
        .Subject = "Lüftungsturm_ALS-KD_" & Sheets("Deckblatt").Range("B9").Value & "_BV: " & Sheets("Deckblatt").Range("B16").Value & "_" & Sheets("Deckblatt").Range("B19").Value
        'Datei anhängen
        .attachments.Add AWS
        'Hier wird ein normaler Text erstellt
        .body = "Sehr geehrte Damen und Herren," & vbCr & vbCr & "bitte senden Sie mir ein Angebot gemäß der beiliegenden Auswahl zu." & vbCr & vbCr & "Das Angebot benötigen wir bis zum ?????." '_
                'Signatur
                '& vbCr & vbCr & "Mit freundlichen Grüßen" & vbCr & _
                'Sheets("Deckblatt").Range("B15").Value & " " & Sheets("Deckblatt").Range("B12").Value & vbCr & _
                'Sheets("Deckblatt").Range("B9").Value
                
        'Hier wird die Mail nochmals angezeigt
        .Display
    End With
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 1103872 bytes
SHA-256: 3d06720a8d905987adac4ae13a4fe587abb6dd843bd0440e8276c812dea30e63
emf_00.emf ooxml-emf OOXML EMF part: xl/media/image129.emf 2524 bytes
SHA-256: 5e86b78661b5d1896b536813eeb6a2cf0f5b15caf6da2fe552e70602348faef2
emf_01.emf ooxml-emf OOXML EMF part: xl/media/image130.emf 2660 bytes
SHA-256: 1344c6c2533bcc8ee164ec83a197c4226b0f3d5ea8dea1cb67685b970ba923d0
emf_02.emf ooxml-emf OOXML EMF part: xl/media/image58.emf 130576 bytes
SHA-256: 940152f9c940a0a3db3c5b4af5de3c80ae20267de874eb8aaee7c32107205318
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Static shellcode analysis found candidate code region(s). Indicators: heap spray 0x0C
emf_03.emf ooxml-emf OOXML EMF part: xl/media/image59.emf 107812 bytes
SHA-256: e8e420de92c7cbd513546b58ba0a962ca3716c03c427b039eb6d880fdf6145f5
emf_04.emf ooxml-emf OOXML EMF part: xl/media/image60.emf 277192 bytes
SHA-256: 0bbcac209dba3767c0290285b999f144cea5291c93f23205005855b96d4f9a2d
emf_05.emf ooxml-emf OOXML EMF part: xl/media/image78.emf 75888 bytes
SHA-256: 0414a9e0a7a41e7f7f275aabde1c0603bd14519b7c59a95f1ae09a0d1d8a215d
emf_06.emf ooxml-emf OOXML EMF part: xl/media/image80.emf 312456 bytes
SHA-256: 43a563a282f79c4e98515067af8d22cc07a76f94ea1a9c8456fd761ecffde02c
emf_07.emf ooxml-emf OOXML EMF part: xl/media/image81.emf 551744 bytes
SHA-256: f5dc3536028a98d79cb2746212f6eda0454d00ac0cbfcde03adbd0564fb1d5dc
emf_08.emf ooxml-emf OOXML EMF part: xl/media/image82.emf 207620 bytes
SHA-256: 47be9089a413f9443de2d0c5e71593224ba65874d4b68e9ce69918e32b74c02e
emf_09.emf ooxml-emf OOXML EMF part: xl/media/image83.emf 426412 bytes
SHA-256: 8f550e632624e3b76ea4b66c75f9c6f29662cd9392ea724001d033caa9269ae0
emf_14.emf ooxml-emf OOXML EMF part: xl/media/image136.emf 2524 bytes
SHA-256: 48dd86ca2b72f76cb620858ace2debf190c7e5422bce2975296dd27488d00cb1
emf_15.emf ooxml-emf OOXML EMF part: xl/media/image137.emf 2660 bytes
SHA-256: c84bce84f31b4eb956c2f449b00a4347b71fe1563497de208c1a8d5362032770
emf_16.emf ooxml-emf OOXML EMF part: xl/media/image149.emf 3116 bytes
SHA-256: ce485af1b9463943730d46a70ff4f20b7254124363477bb852af8e3479690927
emf_17.emf ooxml-emf OOXML EMF part: xl/media/image148.emf 2960 bytes
SHA-256: 386ffe7ec048cf0e0e8d92b930e9506f220355e8b51db6bd33b8520ef36a78f4
emf_20.emf ooxml-emf OOXML EMF part: xl/media/image10.emf 2720 bytes
SHA-256: cd36cc8c9d412e2ca71df66c6992b3032b3fa682b47876e1aadae9103f15b3c7
emf_21.emf ooxml-emf OOXML EMF part: xl/media/image11.emf 2772 bytes
SHA-256: 6408f318c1abf05caedd856142529451afdb666936ff952f5c35dd0eac79ef8f
emf_22.emf ooxml-emf OOXML EMF part: xl/media/image12.emf 2736 bytes
SHA-256: 6b060e3baf3d6c7b7a96a0f7c8e5122da5fd9716de1c826f8bff6acb5f7a52ea
emf_23.emf ooxml-emf OOXML EMF part: xl/media/image13.emf 2652 bytes
SHA-256: 6139598ccec68436a9a87a4d3d01fbbde7456d59ba22cc3f645916f5c1edea9a
emf_24.emf ooxml-emf OOXML EMF part: xl/media/image14.emf 2720 bytes
SHA-256: 5cfeaf1164f158ef989cadd28ea32c1d3670ee88c8239360845d369f462824e9
emf_25.emf ooxml-emf OOXML EMF part: xl/media/image9.emf 2652 bytes
SHA-256: d115896cdf6190d10815d02f34190db024db0ec7f0b030871cf3281b69dd7522
emf_26.emf ooxml-emf OOXML EMF part: xl/media/image8.emf 2636 bytes
SHA-256: 9947e6da24dc6a31ee5fbf7b04e611534c706eb004050c82564eb44ce9a15106
emf_27.emf ooxml-emf OOXML EMF part: xl/media/image7.emf 2384 bytes
SHA-256: e534d02af095999cbadfb445dcd55b7a7deabb0f88d25ce250fe0c6e986ffedd
emf_28.emf ooxml-emf OOXML EMF part: xl/media/image3.emf 2756 bytes
SHA-256: 49a9061b648fa13f9e670fd1b33e5687bd39b9f3672f06504474561e6061978a
emf_29.emf ooxml-emf OOXML EMF part: xl/media/image4.emf 2880 bytes
SHA-256: 5723c0842e0792e91086d69eccadb5c8acd052ee86189790e9209feacb50509a
emf_30.emf ooxml-emf OOXML EMF part: xl/media/image5.emf 2416 bytes
SHA-256: b2ea467c193da1e175942cbfc09aeeb1fd7d38952fa7a1d0236d99511da0cc00
emf_31.emf ooxml-emf OOXML EMF part: xl/media/image6.emf 2488 bytes
SHA-256: d17efdf64de5fdde98f4c5cfa210e37042e3a44519f2ce40a113b83431278699
emf_32.emf ooxml-emf OOXML EMF part: xl/media/image15.emf 2672 bytes
SHA-256: 49b74282f22d84bee2d5a9cb85a6ef78767c38f2ef07aabf6cfe3ae11571f8d8
emf_33.emf ooxml-emf OOXML EMF part: xl/media/image16.emf 2724 bytes
SHA-256: 306fa5c0cb7ed628db476ffeb43ebca5c337ead6df90f5ef2c68e55c88c9c768
emf_34.emf ooxml-emf OOXML EMF part: xl/media/image17.emf 2708 bytes
SHA-256: 90ac96a77dc9e2d1768380f91c270ff1ba2e427bbc70d25a65c47daa964a19ff
emf_35.emf ooxml-emf OOXML EMF part: xl/media/image25.emf 2960 bytes
SHA-256: 57c264f3f723cd30306aef1fbb2f8dcd39166d30c7d9044549b0044c4d8a06a9

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