Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 f90c181d2a58ed7b…

MALICIOUS

Office (OOXML)

164.4 KB Created: 2021-01-22 08:00:16 UTC Authoring application: Microsoft Excel 14.0300 First seen: 2021-11-22
MD5: c05842419a6d1a1fd64ed65db17be67f SHA-1: 8d51a24ff87ecd6fdbd215e9278ee773704a00ae SHA-256: f90c181d2a58ed7b725959abba2719822c68193c2464869ee7de7b9883f1e5f3
238 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File: User Execution T1566.001 Spearphishing Attachment

The sample is an Excel document containing a Workbook_Open macro that uses WScript.Shell to execute commands. The macro attempts to display several user forms and interact with Internet Explorer, likely to present a lure to the user. The obfuscated string 'Shell.Application' indicates the use of potentially dangerous APIs. The embedded URLs point to an internal IP address, suggesting a targeted or internal network compromise.

Heuristics 8

  • VBA project inside OOXML medium 6 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
    Dim i As Integer
i = CreateObject("Wscript.shell").popup("Attendere prego...", 1, "ELABORAZIONE IN CORSO")
  • Dangerous API name reassembled from split string literals critical OLE_VBA_SPLIT_KEYWORD_OBFUSCATION
    VBA concatenates short string literals that reassemble a dangerous API/ProgID/LOLBin name (e.g. Scripting.FileSystemObject, WScript.Shell, powershell, URLDownloadToFile) which appears in no single literal. Splitting an API name across string concatenation is done only to evade keyword scanning.
    Matched line in script
        Dim name As String
    Set explorers = CreateObject("Shell.application").Windows
    For X = explorers.Count - 1 To 0 Step -1
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Dim name As String
    Set explorers = CreateObject("Shell.application").Windows
    For X = explorers.Count - 1 To 0 Step -1
  • 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
    Private Sub Workbook_Open()
Application.Visible = False
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
      Set objImage = objCommonDialog.ShowAcquireImage
  stringanome = Environ$("TEMP") & "\Scan.jpg"
  If Not objImage Is Nothing Then
  • 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://10.146.6.9/lvis/loginForm.jsp In document text (OOXML body / shared strings)
    • http://10.146.6.9/lvis/ewaf/ricerche?_SNT=true&tipoRicerca=3&new=yIn document text (OOXML body / shared strings)
    • http://10.146.6.9/lvis/ewaf/caricaPraticaDaCodicePratica?codPra=In document text (OOXML body / shared strings)
    • https://translate.google.com/m?hl=In document text (OOXML body / shared strings)

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 36653 bytes
SHA-256: d836366f9e0dc85b4ee537c7f9ee6fe901321dd8395e7f72059bec9907d39347
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisWorkbook"
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)
ThisWorkbook.Worksheets("Sheet1").Select
Range("P2").Value = vbNullString
Range("P3").Value = vbNullString
Call CancellaForma
ThisWorkbook.Save
Application.Quit
End Sub

Private Sub Workbook_Open()
Application.Visible = False
Call CloseIE

Call AggiungiForma

MsgBox ("NON AVVIARE INTERNET EXPLORER MENTRE QUESTO") & vbNewLine & ("APPLICATIVO E' IN ELABORAZIONE E ACCERTARSI DI") & _
vbNewLine & ("NON ESSERE GIA' LOGGATI SU ALTRO PC."), , "ATTENZIONE !"

If ThisWorkbook.Worksheets("Sheet1").Range("W2").Value = vbNullString Then UserForm9.Show
If Year(Date) <> ThisWorkbook.Worksheets("Sheet1").Range("AA2").Value Then MsgBox ("PROCEDERE SUBITO CON IL RESET DEI REGISTRI")
UserForm4.Show
End Sub

Attribute VB_Name = "Sheet1"
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 = "mod_IE_Tools"
Option Explicit

Sub waitFor(IE As InternetExplorer)
    Do
        Do
            Application.Wait Now + TimeValue("00:00:01")
            attach IE
            DoEvents
        Loop Until Not IE.Busy And IE.readystate = 4
        Application.Wait Now + TimeValue("00:00:01")
    Loop Until Not IE.Busy And IE.readystate = 4
End Sub

Function attach(IE As Object, Optional urlPart As String) As Boolean
    Dim o As Object
    Dim X As Long
    Dim explorers As Object
    Dim name As String
    Set explorers = CreateObject("Shell.application").Windows
    For X = explorers.Count - 1 To 0 Step -1
       name = "Empty"
       On Error Resume Next
       name = explorers((X)).name
       On Error GoTo 0
       If name = "Internet Explorer" Then
          If InStr(1, explorers((X)).LocationURL, urlPart, vbTextCompare) Then
               Set IE = explorers((X))
               attach = True
               Exit For
          End If
       End If
    Next
    
End Function






Attribute VB_Name = "UserForm1"
Attribute VB_Base = "0{78B87F32-9784-4FB8-B9B9-3B4650B55190}{A55A99B0-D64C-4336-926A-068C58E73E93}"
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 CommandButton1_Click()

Dim lastrow As Long
ThisWorkbook.Worksheets("Sheet2").Activate
lastrow = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ThisWorkbook.Worksheets("Sheet1").Range("A2:I2").Cut ThisWorkbook.Worksheets("Sheet2").Range("A" & lastrow)
'ThisWorkbook.Worksheets("Sheet2").Range("J" & lastrow) = ThisWorkbook.Worksheets("Sheet2").Cells(lastrow, 10) - 1


'ThisWorkbook.Worksheets("Sheet1").Range("J2").Copy ThisWorkbook.Worksheets("Sheet2").Range("J" & lastrow)
Application.CutCopyMode = False
If ThisWorkbook.Worksheets("Sheet1").Range("Z2").Value = "PR" Then
ThisWorkbook.Worksheets("Sheet2").Range("K" & lastrow) = "PR"
UserForm3.Show
End If
If ThisWorkbook.Worksheets("Sheet1").Range("Z2").Value = "DN" Then
ThisWorkbook.Worksheets("Sheet2").Range("K" & lastrow) = "DN"
UserForm7.Show
End If

Unload Me

End Sub

Private Sub CommandButton2_Click()

Call Motivazioni

End Sub

Private Sub TextBox1_Change()
    If Me.TextBox1.TextLength > 299 Then
        Me.TextBox1.BackColor = vbYellow
        Me.Label1.ForeColor = vbRed
    Else
        Me.TextBox1.BackColor = vbWhite
        Me.Label1.ForeColor = vbBlack
    End If
End Sub

Private Sub TextBox2_Change()
    If Me.TextBox2.TextLength > 299 Then
        Me.TextBox2.BackColor = vbYellow
        Me.Label2.ForeColor = vbRed
    Else
        Me.TextBox2.BackColor = vbWhite
        Me.Label2.ForeColor = vbBlack
    End If

Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Activate
ws.Range("H2") = UCase(UserForm1.TextBox2.Text)
End Sub

Private Sub UserForm_Initialize()
Me.TextBox1.Text = vbNullString
Me.TextBox2.Text = vbNullString

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Attribute VB_Name = "Module4"
Option Explicit

Sub Lvis()
Dim IE As InternetExplorer
Dim htmldoc As HTMLDocument
Dim user As String
Dim pwd As String

Dim i As Integer
i = CreateObject("Wscript.shell").popup("Attendere prego...", 1, "ELABORAZIONE IN CORSO")

Application.ScreenUpdating = False
user = Sheets("Sheet1").Range("P2").Value
pwd = Sheets("Sheet1").Range("P3").Value

Set IE = New InternetExplorer

IE.Visible = False

IE.Navigate2 "http://10.146.6.9/lvis/loginForm.jsp"

waitFor IE
Set htmldoc = IE.document

htmldoc.all("username").Value = user
On Error GoTo ERRHANDLER

htmldoc.all("password").Value = pwd
htmldoc.all("Login").Click
waitFor IE
i = CreateObject("Wscript.shell").popup("AUTENTICAZIONE IN CORSO...", 1, "ATTENDERE PREGO")

ERRHANDLER:

If InStr(1, htmldoc.body.innerText, "Lista degli Errori") > 1 Then
MsgBox ("UTENTE o PASSWORD ERRATI o UTENTE GIA' LOGGATO !") & vbNewLine & ("IL PROGRAMMA VERRA' CHIUSO")
Err.Clear
Set IE = Nothing
Application.Quit
Exit Sub
End If

start:

If IE Is Nothing Then
    If attach(IE) = False Then
        Set IE = New InternetExplorer
    End If
End If

IE.Visible = False
IE.Navigate2 "http://10.146.6.9/lvis/ewaf/ricerche?_SNT=true&tipoRicerca=3&new=y"
waitFor IE

Dim codpra As String

codpra = InputBox("INSERIRE IL NUMERO DI PRATICA E" & vbNewLine & "ATTENDERE IL MODULO SUCCESSIVO")
IE.Navigate2 "http://10.146.6.9/lvis/ewaf/caricaPraticaDaCodicePratica?codPra=" & codpra
waitFor IE

IE.Visible = False

ThisWorkbook.Worksheets("Sheet1").Activate

Worksheets("Sheet1").Range("A2").Value = codpra
On Error GoTo PraticanonTrovata

Worksheets("Sheet1").Range("B2").Value = Trim(IE.document.getElementsByClassName("campoNormale")(4).innerText)
On Error GoTo 0

Worksheets("Sheet1").Range("C2").Value = Trim(IE.document.getElementsByClassName("campoNormale")(6).innerText)
Worksheets("Sheet1").Range("D2").Value = Trim(IE.document.getElementsByClassName("campoCorto")(1).innerText)
Worksheets("Sheet1").Range("E2").Value = Trim(IE.document.getElementsByClassName("campoCorto")(3).innerText)
    If IsNumeric(Trim(IE.document.getElementsByClassName("campoNormale")(39).innerText)) Then
    Worksheets("Sheet1").Range("F2").Value = Trim(IE.document.getElementsByClassName("campoNormale")(39).innerText)
    End If
    If IsNumeric(Trim(IE.document.getElementsByClassName("campoNormale")(40).innerText)) Then
    Worksheets("Sheet1").Range("F2").Value = Trim(IE.document.getElementsByClassName("campoNormale")(40).innerText)
    End If
    If IsNumeric(Trim(IE.document.getElementsByClassName("campoNormale")(41).innerText)) Then
    Worksheets("Sheet1").Range("F2").Value = Trim(IE.document.getElementsByClassName("campoNormale")(41).innerText)
    End If
Worksheets("Sheet1").Range("I2").Value = Trim(IE.document.getElementsByClassName("campoNormale")(18).innerText)

UserForm1.Show
Application.ScreenUpdating = True

Dim answer As Integer
 
answer = MsgBox("PROCEDERE CON ALTRO PREAVVISO ?", vbQuestion + vbYesNo + vbDefaultButton2)

If answer = vbYes Then
  GoTo start
Else
  
  Set IE = Nothing
  Application.Quit
  Exit Sub
    
End If

Exit Sub

PraticanonTrovata:

MsgBox ("ERRORE DI SISTEMA O PRATICA NON TROVATA !")
Err.Clear
Set IE = Nothing
Resume start

End Sub

Attribute VB_Name = "Sheet2"
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
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Dim i As Long
'i = Application.WorksheetFunction.CountA(Sheet2.Range("A:A"))
'If i > 1 Then
'Sheet2.Range("J" & i).Value = i - 1
'End If
'End Sub


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lastrow As Long
    lastrow = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

        Application.EnableEvents = False
    
        Range("J" & lastrow).Value = lastrow - 1
    
    Application.EnableEvents = True

End Sub

Attribute VB_Name = "Module1"
Option Explicit

Sub Motivazioni()
Dim stringa As String, TraduX As String
Dim ws As Worksheet
stringa = UserForm1.TextBox1.Text

    Set ws = Worksheets("Sheet1")
    ws.Activate
    
      
        ws.Range("G2") = UCase(stringa)
        
        TraduX = Translate(stringa, "it", "en")
        UserForm1.TextBox2.Text = TraduX
        ws.Range("H2") = UCase(UserForm1.TextBox2.Text)
            
End Sub


Public Function Translate(strInput As String, strFromSourceLanguage As String, strToTargetLanguage As String) As String
    Dim strURL As String
    Dim objHTTP As Object
    Dim objHTML As Object
    Dim objDivs As Object, objDiv As Object
    Dim strTranslated As String

    ' send query to web page
    strURL = "https://translate.google.com/m?hl=" & strFromSourceLanguage & _
        "&sl=" & strFromSourceLanguage & _
        "&tl=" & strToTargetLanguage & _
        "&ie=UTF-8&prev=_m&q=" & strInput

    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP") 'late binding
    objHTTP.Open "GET", strURL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ""

    ' create an html document
    Set objHTML = CreateObject("htmlfile")
    With objHTML
        .Open
        .Write objHTTP.responseText
        .Close
    End With
    
    'Range("H1") = objHTTP.responsetext
    
    Set objDivs = objHTML.getElementsByTagName("div")
    
    For Each objDiv In objDivs

        If objDiv.className = "result-container" Then
            strTranslated = objDiv.innerText
            Translate = strTranslated
        End If
        
    Next objDiv
    
    

    Set objHTML = Nothing
    Set objHTTP = Nothing

End Function


Attribute VB_Name = "Userform2"
Attribute VB_Base = "0{5C3B92D1-B1F3-46BF-81A0-920C5912B887}{B1D07BBD-B505-4C71-8103-600EFDFE5524}"
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 CommandButton1_Click()
ThisWorkbook.Worksheets("Sheet1").Activate
Worksheets("Sheet1").Range("P2").Value = Me.TextBox1.Text
Worksheets("Sheet1").Range("P3").Value = Me.TextBox2.Text
Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
Call Lvis
End Sub

Private Sub CommandButton2_Click()
Dim pwd As String, check As Boolean
pwd = InputBox("Password del Programmatore")
If pwd <> "nexus" Then
Application.Quit
Else
Application.Visible = True
check = True
Unload Me
End If
End Sub

Private Sub TextBox1_Enter()
Me.TextBox1.BackColor = vbYellow
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.TextBox1.BackColor = vbWhite
End Sub
Private Sub TextBox2_Enter()
Me.TextBox2.BackColor = vbYellow
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.TextBox2.BackColor = vbWhite
End Sub

Private Sub UserForm_Initialize()
Me.TextBox1.Text = vbNullString
Me.TextBox2.Text = vbNullString
ThisWorkbook.Worksheets("Sheet1").Range("P2").Value = vbNullString
ThisWorkbook.Worksheets("Sheet1").Range("P3").Value = vbNullString
Me.TextBox1.SetFocus

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Attribute VB_Name = "Module2"
Option Explicit

Sub AvvioLvis()
Userform2.Show

End Sub

Attribute VB_Name = "UserForm3"
Attribute VB_Base = "0{58AE92E5-0F98-48BE-82A5-A640BA0CDF71}{FD2B1407-238C-4ED6-A7DF-4EF8F8CCFAF0}"
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 CommandButton1_Click()
Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
Dim lastrow As Long

ThisWorkbook.Worksheets("Sheet2").Activate
lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

ThisWorkbook.Worksheets("Sheet3").Range("A5").Value = ThisWorkbook.Worksheets("Sheet2").Range("B" & lastrow) & " " & ThisWorkbook.Worksheets("Sheet2").Range("C" & lastrow)
ThisWorkbook.Worksheets("Sheet3").Range("A7").Value = ThisWorkbook.Worksheets("Sheet2").Range("F" & lastrow)
ThisWorkbook.Worksheets("Sheet3").Range("B12").Value = "Reg. N. " & ThisWorkbook.Worksheets("Sheet2").Range("J" & lastrow)
ThisWorkbook.Worksheets("Sheet3").Range("B13").Value = ThisWorkbook.Worksheets("Sheet2").Range("A" & lastrow)
ThisWorkbook.Worksheets("Sheet3").Range("B14").Value = ThisWorkbook.Worksheets("Sheet2").Range("E" & lastrow)
ThisWorkbook.Worksheets("Sheet3").Range("A19").Value = ThisWorkbook.Worksheets("Sheet2").Range("G" & lastrow)
ThisWorkbook.Worksheets("Sheet3").Range("C19").Value = ThisWorkbook.Worksheets("Sheet2").Range("H" & lastrow)
ThisWorkbook.Worksheets("Sheet3").Range("A24").Value = ThisWorkbook.Worksheets("Sheet3").Range("A3").Value & ", " & Format(Date, "dd/mm/yyyy")

ThisWorkbook.Worksheets("Sheet3").PrintOut
ThisWorkbook.Worksheets("Sheet1").Activate

End Sub

Private Sub CommandButton2_Click()
MsgBox ("NESSUNA MODIFICA APPORTATA !")
Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
Dim lastriga As Long

ThisWorkbook.Worksheets("Sheet2").Activate
    lastriga = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
       
    Rows(lastriga).Delete
    ThisWorkbook.Worksheets("Sheet1").Select

End Sub

Private Sub TextBox4_Change()
Dim ultRiga As Long
ThisWorkbook.Worksheets("Sheet2").Activate
    ultRiga = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Sheet2").Range("F" & ultRiga).Value = Me.TextBox4.Text
End Sub

Private Sub UserForm_Initialize()
Dim lsrow As Long

lsrow = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Me.TextBox1.Text = Sheets("Sheet2").Range("A" & lsrow).Value
Me.TextBox2.Text = Sheets("Sheet2").Range("B" & lsrow).Value
Me.TextBox3.Text = Sheets("Sheet2").Range("C" & lsrow).Value
Me.TextBox4.Text = Sheets("Sheet2").Range("F" & lsrow).Value
'Sheets("Sheet1").Range("J2").Value = Sheets("Sheet2").Range("J" & lsrow).Value
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Attribute VB_Name = "Sheet3"
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 = "Sheet4"
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 = "Sheet5"
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 = "UserForm4"
Attribute VB_Base = "0{5A33F74C-2C07-4AA6-9521-04E365617747}{70FDA8CC-C794-4D00-BF12-7193EFD4898C}"
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 CommandButton1_Click()
Dim pwd As String, check As Boolean
pwd = InputBox("Password del Programmatore")
If pwd <> "nexus" Then
Application.Quit
Else
Application.Visible = True
check = True
Unload Me
End If

End Sub

Private Sub CommandButton2_Click()
Unload Me
Application.Quit

End Sub

Private Sub CommandButton3_Click()
Unload Me
ThisWorkbook.Worksheets("Sheet6").Activate
ThisWorkbook.Worksheets("Sheet6").Range("D2").Value = vbNullString
Call CancellaRighe
ThisWorkbook.Worksheets("Sheet1").Range("AA2").Value = Year(Date)

End Sub

Private Sub CommandButton4_Click()
ThisWorkbook.Worksheets("Sheet2").Activate
    With ActiveSheet.PageSetup
        .PrintArea = Intersect(Range("A:K"), ActiveSheet.UsedRange).Address
        Range("F:H").EntireColumn.Hidden = True
        .Orientation = xlLandscape
    End With
 ActiveSheet.PrintOut
 Range("F:H").EntireColumn.Hidden = False
 ThisWorkbook.Worksheets("Sheet1").Select
 
 End Sub

Private Sub Label3_Click()
  Call FileExistsDemo
End Sub

Private Sub OptionButton1_Click()
ThisWorkbook.Worksheets("Sheet1").Range("Z2").Value = "PR"
Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
UserForm5.Show

End Sub

Private Sub OptionButton2_Click()
ThisWorkbook.Worksheets("Sheet1").Range("Z2").Value = "DN"
Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
UserForm6.Show

End Sub

Private Sub OptionButton3_Click()
Application.Wait (Now + TimeValue("00:00:01"))
Unload Me
UserForm10.Show

End Sub

Private Sub UserForm_Initialize()
Me.Label1.Caption = ThisWorkbook.Worksheets("Sheet3").Range("A2").Value & vbNewLine & ThisWorkbook.Worksheets("Sheet3").Range("A3").Value
If Year(Date) <> ThisWorkbook.Worksheets("Sheet1").Range("AA2").Value Then
Me.CommandButton3.Visible = True
Else
Me.CommandButton3.Visible = False
End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub


Attribute VB_Name = "UserForm5"
Attribute VB_Base = "0{C6D31468-0E51-408C-8BAC-3D9AD14A5141}{3F3542F6-0680-4D56-B73A-7363BDFF9FDF}"
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 CommandButton1_Click()
Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
Userform2.Show

End Sub

Private Sub CommandButton2_Click()
Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
UserForm4.Show

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Attribute VB_Name = "UserForm6"
Attribute VB_Base = "0{52A0B746-E164-4E6E-9E6D-5DD67808EDB0}{1D32434B-5E2D-45AA-BBA5-60D38AFDD14A}"
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 CommandButton1_Click()
Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
UserForm8.Show

End Sub

Private Sub CommandButton2_Click()
Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
UserForm4.Show

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Attribute VB_Name = "UserForm7"
Attribute VB_Base = "0{15E21522-2AA3-4782-8C71-C87D216CF73E}{BAE8AE61-44AC-4091-AB8E-99B4B4CECCAF}"
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 CommandButton2_Click()
MsgBox ("NESSUNA MODIFICA APPORTATA !")
Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
Dim lastriga As Long

ThisWorkbook.Worksheets("Sheet2").Activate
    lastriga = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    Rows(lastriga).Delete
ThisWorkbook.Worksheets("Sheet1").Activate
Dim regDin As Long
    regDin = ThisWorkbook.Worksheets("Sheet1").Range("J2").Value
    regDin = regDin - 1
End Sub

Private Sub CommandButton3_Click()

Unload Me
Application.Wait (Now + TimeValue("00:00:01"))
ThisWorkbook.Worksheets("Sheet2").Activate
Dim lastrow As Long
lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
ThisWorkbook.Worksheets("Sheet4").Range("A3").Value = "Reg. N. " & ThisWorkbook.Worksheets("Sheet2").Range("J" & lastrow)
ThisWorkbook.Worksheets("Sheet4").Range("A4").Value = "Pratica N. " & ThisWorkbook.Worksheets("Sheet2").Range("A" & lastrow)
ThisWorkbook.Worksheets("Sheet4").Range("A5").Value = "Cognome e Nome : " & ThisWorkbook.Worksheets("Sheet2").Range("B" & lastrow) & " " & ThisWorkbook.Worksheets("Sheet2").Range("C" & lastrow)
ThisWorkbook.Worksheets("Sheet4").Range("A6").Value = "Data di nascita : " & ThisWorkbook.Worksheets("Sheet2").Range("D" & lastrow)
ThisWorkbook.Worksheets("Sheet4").Range("A7").Value = "Passaporto n./Passport n. : " & ThisWorkbook.Worksheets("Sheet2").Range("E" & lastrow)
ThisWorkbook.Worksheets("Sheet4").Range("A8").Value = "Visto richiesto/Visa type : " & ThisWorkbook.Worksheets("Sheet2").Range("I" & lastrow)
ThisWorkbook.Worksheets("Sheet4").Range("A42").Value = ThisWorkbook.Worksheets("Sheet2").Range("G" & lastrow)
ThisWorkbook.Worksheets("Sheet4").Range("A43").Value = ThisWorkbook.Worksheets("Sheet2").Range("H" & lastrow)
ThisWorkbook.Worksheets("Sheet4").Range("A52").Value = ThisWorkbook.Worksheets("Sheet3").Range("A3").Value & ", " & Format(Date, "dd/mm/yyyy")
ThisWorkbook.Worksheets("Sheet4").PrintOut
ThisWorkbook.Worksheets("Sheet1").Activate

End Sub

Private Sub UserForm_Initialize()
Dim lsrow As Long

lsrow = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Me.TextBox1.Text = Sheets("Sheet2").Range("A" & lsrow).Value
Me.TextBox2.Text = Sheets("Sheet2").Range("B" & lsrow).Value
Me.TextBox3.Text = Sheets("Sheet2").Range("C" & lsrow).Value

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then Cancel = True
End Sub

Attribute VB_Name = "UserForm8"
Attribute VB_Base = "0{C6EA4717-CACC-49D8-83B3-3ED0FAF61181}{9151E8B1-24AE-440E-A800-E52775AA4E86}"
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 CommandButton1_Click()
    ThisWorkbook.Worksheets("Sheet1").Activate
    Worksheets("Sheet1").Range("P2").Value = Me.TextBox1.Text
    Worksheets("Sheet1").Range("P3").Value = Me.TextBox2.Text
    Unload Me
    Application.Wait (Now + TimeValue("00:00:01"))
Call Lvis2
End Sub

Private Sub CommandButton2_Click()
    Application.Visible = True
End Sub

Private Sub TextBox1_Enter()
    Me.TextBox1.BackColor = vbYellow
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Me.TextBox1.BackColor = vbWhite
End Sub
Private Sub TextBox2_Enter()
    Me.TextBox2.BackColor = vbYellow
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Me.TextBox2.BackColor = vbWhite
End Sub

Private Sub UserForm_Initialize()
    Me.TextBox1.Text = vbNullString
    Me.TextBox2.Text = vbNullString
    ThisWorkbook.Worksheets("Sheet1").Range("P2").Value = vbNullString
    ThisWorkbook.Worksheets("Sheet1").Range("P3").Value = vbNullString
    Me.TextBox1.SetFocus
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then Cancel = True
End Sub

Attribute VB_Name = "Module3"
Option Explicit

Sub Lvis2()
Dim IE As InternetExplorer
Dim htmldoc As HTMLDocument
Dim user As String
Dim pwd As String
Dim i As Integer

i = CreateObject("Wscript.shell").popup("Attendere prego...", 1, "ELABORAZIONE IN CORSO")

user = Sheets("Sheet1").Range("P2").Value
pwd = Sheets("Sheet1").Range("P3").Value

Set IE = New InternetExplorer

IE.Visible = False

IE.Navigate2 "http://10.146.6.9/lvis/loginForm.jsp"

waitFor IE
Set htmldoc = IE.document
htmldoc.all("username").Value = user
On Error GoTo ERRHANDLER

htmldoc.all("password").Value = pwd
htmldoc.all("Login").Click
waitFor IE
i = CreateObject("Wscript.shell").popup("AUTENTICAZIONE IN CORSO...", 1, "ATTENDERE PREGO")
ERRHANDLER:

If InStr(1, htmldoc.body.innerText, "Lista degli Errori") > 1 Then
MsgBox ("UTENTE o PASSWORD ERRATI o UTENTE GIA' LOGGATO !") & vbNewLine & ("IL PROGRAMMA VERRA' CHIUSO")
Err.Clear
Set IE = Nothing
Application.Quit
Exit Sub
End If

start:

If IE Is Nothing Then
    If attach(IE) = False Then
        Set IE = New InternetExplorer
    End If
End If

IE.Visible = False
IE.Navigate2 "http://10.146.6.9/lvis/ewaf/ricerche?_SNT=true&tipoRicerca=3&new=y"
waitFor IE

Dim codpra As String

codpra = InputBox("INSERIRE IL NUMERO DI PRATICA E" & vbNewLine & "ATTENDERE IL MODULO SUCCESSIVO")
IE.Navigate2 "http://10.146.6.9/lvis/ewaf/caricaPraticaDaCodicePratica?codPra=" & codpra
waitFor IE
On Error GoTo PraticanonTrovata
IE.Visible = False

ThisWorkbook.Worksheets("Sheet1").Activate

Worksheets("Sheet1").Range("A2").Value = codpra
Worksheets("Sheet1").Range("B2").Value = Trim(IE.document.getElementsByClassName("campoNormale")(4).innerText)
On Error GoTo 0

Worksheets("Sheet1").Range("C2").Value = Trim(IE.document.getElementsByClassName("campoNormale")(6).innerText)
Worksheets("Sheet1").Range("D2").Value = Trim(IE.document.getElementsByClassName("campoCorto")(1).innerText)
Worksheets("Sheet1").Range("E2").Value = Trim(IE.document.getElementsByClassName("campoCorto")(3).innerText)
Worksheets("Sheet1").Range("F2").Value = Trim(IE.document.getElementsByClassName("campoNormale")(41).innerText)
Worksheets("Sheet1").Range("I2").Value = Trim(IE.document.getElementsByClassName("campoNormale")(18).innerText)

UserForm1.Show
Application.ScreenUpdating = True

Dim answer As Integer
 
answer = MsgBox("PROCEDERE CON ALTRO DINIEGO ?", vbQuestion + vbYesNo + vbDefaultButton2)

If answer = vbYes Then
  GoTo start
Else
  Set IE = Nothing
  Application.Quit
  Exit Sub
    
End If

Exit Sub

PraticanonTrovata:

MsgBox ("ERRORE DI SISTEMA O PRATICA NON TROVATA !")
Err.Clear
Set IE = Nothing
Resume start

End Sub


Attribute VB_Name = "Sheet6"
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 = "UserForm9"
Attribute VB_Base = "0{F74A0229-6BF6-42AB-B8BE-F713C072410D}{A2B89B47-8A0A-4520-957E-A8864EA79D49}"
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

Private Sub CommandButton1_Click()
ThisWorkbook.Worksheets("Sheet1").Activate
ThisWorkbook.Worksheets("Sheet1").Range("AA2").Value = Year(Date)
ThisWorkbook.Worksheets("Sheet1").Range("W2").Value = "Attivo"
ThisWorkbook.Worksheets("Sheet3").Activate
ThisWorkbook.Worksheets("Sheet3").Range("A2").Value = UCase(Me.TextBox1.Text)
ThisWorkbook.Worksheets("Sheet3").Range("A3").Value = UCase(Me.TextBox2.Text)
ThisWorkbook.Worksheets("Sheet3").Range("C1").Value = UCase(Me.TextBox3.Text)
ThisWorkbook.Worksheets("Sheet4").Activate
ThisWorkbook.Worksheets("Sheet4").Range("A2").Value = UCase(Me.TextBox1.Text & " " & Me.TextBox2.Text)
ThisWorkbook.Worksheets("Sheet5").Activate
ThisWorkbook.Worksheets("Sheet5").Range("A2").Value = UCase(Me.TextBox1.Text)
ThisWorkbook.Worksheets("Sheet5").Range("A3").Value = UCase(Me.TextBox2.Text)
ThisWorkbook.Worksheets("Sheet1").Select

Unload Me
UserForm4.Show
End Sub

Private Sub TextBox1_Enter()
    Me.TextBox1.BackColor = vbWhite
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.TextBox1.Text = vbNullString Then
        Me.Label5.Visible = True
        Me.TextBox1.BackColor = vbYellow
    End If
End Sub

Private Sub TextBox2_Enter()
    Me.TextBox2.BackColor = vbWhite
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.TextBox2.Text = vbNullString Then
        Me.Label5.Visible = True
        Me.TextBox2.BackColor = vbYellow
    End If
End Sub

Private Sub UserForm_Initialize()
    Me.Label5.Visible = False
    Me.TextBox1.SetFocus
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then Cancel = True
End Sub

Attribute VB_Name = "Module7"
Option Explicit

Sub CancellaRighe()

Dim riga As Long, ultimaRow As Long, i As Long, annocorr, annoprec As String
annocorr = Year(Date)
annoprec = annocorr - 1

ThisWorkbook.Worksheets("Sheet2").Activate
If Not Cells.Find(what:=annoprec) Is Nothing Then
Cells.Find(what:=annoprec).Activate
riga = ActiveCell.Row
ultimaRow = ActiveCell.End(xlDown).Row

    For i = ultimaRow To riga Step -1
    ActiveCell.EntireRow.Delete
    Next i
Else
MsgBox ("NESSUNA REGISTRAZIONE TROVATA PER L'ANNO PRECEDENTE !")
End If

Cells(1, 1).Select

MsgBox ("REGISTRI PER L'ANNO ") & annocorr & (" INIZIALIZZATI CORRETTAMENTE!")
ThisWorkbook.Worksheets("Sheet2").Cells(1, 1).Select

UserForm4.Show

End Sub


Attribute VB_Name = "Module5"
Option Explicit

Sub Scan()
  Dim objCommonDialog As WIA.CommonDialog
  Dim objImage As WIA.ImageFile
  Dim stringanome As String
  Dim shp As ShapeRange
    Set objCommonDialog = New WIA.CommonDialog
  Set objImage = objCommonDialog.ShowAcquireImage
  stringanome = Environ$("TEMP") & "\Scan.jpg"
  If Not objImage Is Nothing Then
    If Dir(stringanome) <> "" Then Kill stringanome
    objImage.SaveFile stringanome
    DoEvents
    ThisWorkbook.Worksheets("Sheet5").Activate
    Set shp = ActiveSheet.Shapes.Range(Array("Rectangle2"))
    With shp.Fill
    .Visible = msoTrue
    .UserPicture stringanome
    .TextureTile = msoFalse
    .RotateWithObject = msoTrue
    End With
    With shp
    .LockAspectRatio = msoFalse
    .IncrementLeft 2
    End With
    
        
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 296448 bytes
SHA-256: 7e4a8532bea7f103e670b63969fab48ad3c8b47ee049cf56f452dd01f169f479

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