Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 0532ba647903a1c8…

MALICIOUS

Office (OOXML)

1.98 MB Created: 2017-12-04 19:12:16 UTC Authoring application: Microsoft Excel 15.0300 First seen: 2021-06-17
MD5: efc91edb22f46689799f13c2967b565e SHA-1: 81a026c3d83ebf251dae55333a04c17f9f61ce78 SHA-256: 0532ba647903a1c88d2eb0d6c735a8fe211b58e3b3ea280f11bb8d411e52435c
370 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1059.007 JavaScript T1203 Exploitation for Client Execution

The VBA script uses WScript.Shell and CreateObject to execute external programs, specifically targeting SAP Logon. It attempts to launch SAP Logon and potentially automate the login process to internal SAP systems. The ClamAV detection and multiple critical heuristics for VBA shell usage indicate malicious intent, likely to facilitate unauthorized access or data exfiltration from SAP.

Heuristics 9

  • ClamAV: Xls.Macro.Obfuscation-9804250-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Xls.Macro.Obfuscation-9804250-0
  • VBA project inside OOXML medium 5 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
                    Set aw = session.ActiveWindow()
                Set GRID1 = aw.findById("wnd[0]/usr/cntlGRID1/shellcont/shell")
                            For I = 0 To GRID1.RowCount - 1
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
    Dim arrConexion(3, 10)
Set WshShell = CreateObject("WScript.Shell")
    Select Case connectTo 'Selector de Conector segun ID SAP
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    Dim arrConexion(3, 10)
Set WshShell = CreateObject("WScript.Shell")
    Select Case connectTo 'Selector de Conector segun ID SAP
  • GetObject call high OLE_VBA_GETOBJ
    GetObject call
    Matched line in script
        If Not IsObject(Application1) Then
       Set SapGuiAuto = GetObject("SAPGUI")
       Set Application1 = SapGuiAuto.GetScriptingEngine
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
    '''
'''    usarioo = UCase(Environ("username"))
'''    Select Case usarioo
  • External relationship medium OOXML_EXTERNAL_REL
    External target in xl/externalLinks/_rels/externalLink1.xml.rels: /Users/crirod/Google Drive/Proyecto Automatizacion 2018/archivos paraLevantar/MACRO_Modificacion de artículos Supermerca
  • 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://portalsap.cencosud.corp/PE0 OOXML external relationship
    • http://portalsap.cencosud.corp/P03OOXML external relationship
    • https://portalsap.cencosud.corp/SecureLoginServer/webclient/webclient.html?profile=4ae8fa8e-21b2-45b4-a022-5cbd56798450OOXML external relationship
    • http://portalsap.cencosud.corp/PP0OOXML external relationship
    • https://www.youtube.com/watch?v=gFZfwWZV074OOXML external relationship
    • https://api.whatsapp.com/send?phone=OOXML external relationship

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) 151517 bytes
SHA-256: 0156b3b334135ef9d64bd373b661600bf065fd7177503f2c3cc81398d48e5d96
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

Attribute VB_Name = "Hoja1"
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 = "E_Funciones"
Public Function PortalSAP()
'Stop 'revisar
Kill_SAP
    ConnectSapTo (ambiente)
End Function

Public Function ConnectSapTo(connectTo)

Dim WshShell
Dim SAPAlreadyRunning:                  SAPAlreadyRunning = 0
Dim SapAccessedWindowName:              SapAccessedWindowName = "SAP Easy Access"
Dim arrConexion(3, 10)
Set WshShell = CreateObject("WScript.Shell")
    Select Case connectTo 'Selector de Conector segun ID SAP
    Case "RP9": connection = "004. RP9 - Supermercados Perú"
    Case "PE0": connection = "003. PE0 - ERP MdH (Easy - Blaisten)"
    Case "P03": connection = "002. P03 - ERP Supermercados Chile"
    Case "PFO": connection = "001. PF0 - SAP FICO"
    End Select
v_Return = WshShell.Run("""C:\Program Files (x86)\SAP\FrontEnd\SAPgui\SapLogon""", 1, False) 'Ejecuta Sap LogOn
'v_Return = WshShell.Run("""C:\Program Files (x86)\SAP\SapSetup\setup\SAL\SapLogon.s8l""", 1, False) 'Ejecuta Sap LogOn revisar ruta de donde esta a veces falla...

pid = WaitForProcess("saplogon.exe", 7) 'Wait to load in Windows ...
'Se Loguea busca el PID activa la applicacion del logon y comienza a loguearse
    If pid > 0 Then
       WshShell.AppActivate pid
        'Ya con la app abierta me logueo con usuario y contraseña
Esperar (20)
    If Not IsObject(Application1) Then
       Set SapGuiAuto = GetObject("SAPGUI")
       Set Application1 = SapGuiAuto.GetScriptingEngine
    End If
    If Not IsObject(connection) Then
      Set connection = Application1.OpenConnection(connection, True)
    End If
    If Not IsObject(sapsession) Then
       Set session = connection.Children(0)
    End If
    If IsObject(WScript) Then
       WScript.ConnectObject Application1, "on"
    End If
        
        ''sapsessionPEW.findById("wnd[0]").resizeWorkingPane 69, 23, False para ponerlo en maximizado...
    Else 'en caso de No encontrar el PID
    Stop 'No encontro SAPLogon.exe Abierto
    End If
session.findById("wnd[0]").maximize 'Maximizar SAP
''''para que funcione tener siepre en cuanta activar las referencias de vba complementos
''''Set WBMacroCris = ThisWorkbook
'''    Dim ie
'''    Dim doc
'''    Dim loaderSAP '
'''    Dim usuario
'''    Dim Contrasena
'''    'por si cambia usuario y contrasñea modificarlo aca mono"
'''    'tengo q pedir usuario y contraseña al que tiene la planilla con inputbox
'''
'''    usarioo = UCase(Environ("username"))
'''    Select Case usarioo
'''                Case "RDPALMA"
'''                usuario = "rdpalma"
'''                Contrasena = "medialuna16"
'''                Case "CRIROD"
'''                usuario = "crirod"
'''                Contrasena = Decrypt(WBMacroCris.Sheets("Hoja1").Range("L14").value)
'''    End Select
'''
''''Forzado para Usuario ROBOTUCDM_10
'''usuario = "ROBOTUCDM_10"
'''Contrasena = "2k1hz7i6"
''''************************************
'''
'''    Set ie = New InternetExplorerMedium
'''    '''Set ie = CreateObject("InternetExplorer.Application")
'''    ie.Visible = True 'hago visible a internet explorer
'''                If ambiente = "PE0" Then 'comienzo a decirle q sap debe abrir dependiento el ambiente q necesito
'''                    ie.navigate ("http://portalsap.cencosud.corp/PE0")
'''                ElseIf ambiente = "P03" Then
'''                    ie.navigate ("http://portalsap.cencosud.corp/P03")
'''                ElseIf ambiente = "RP9" Then
'''                     ie.navigate ("https://portalsap.cencosud.corp/SecureLoginServer/webclient/webclient.html?profile=4ae8fa8e-21b2-45b4-a022-5cbd56798450")
'''                ElseIf ambiente = "PP0" Then
'''                    ie.navigate ("http://portalsap.cencosud.corp/PP0")
'''                End If
'''            Do Until ie.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop 'el loop para que responda cuando complete de cargar IE
'''    Set doc = ie.Document
'''        With doc
'''            On Error Resume Next
'''            Set loaderSAP = .getelementbyid("SNCForm1").Children(0).Children(0).Children(0).Children(0).Children(0).Children(0).Children(1)
'''            Do Until loaderSAP Is Nothing
'''                Set loaderSAP = .getelementbyid("SNCForm1").Children(0).Children(0).Children(0).Children(0).Children(0).Children(0).Children(1)
'''            Loop
'''            On Error GoTo 0
'''            application.Wait (Now + TimeValue("00:00:10")) 'espero a que responda pagina
'''                On Error Resume Next
'''            .getelementbyid("un").value = usuario
'''            .getelementbyid("pw").value = Contrasena
'''            .getelementbyid("logon").Click
'''                On Error GoTo 0
'''        End With
'''application.Wait (Now + TimeValue("00:00:15")) 'espero a que se abra sap ...
End Function

Public Function ConnectSAPSecureLogin(IDConexionSap, NombreConexion, user, pass)
  Dim WshShell
  Dim SAPAlreadyRunning: SAPAlreadyRunning = 0
  Dim SapAccessedWindowName: SapAccessedWindowName = "SAP Easy Access"
  Dim arrConexion(3, 10)
 
  Set WshShell = CreateObject("WScript.Shell")
        connection = IDConexionSap
        'NombreConexion = "501.- Finanzas ERP - PEW - produccion"
        'abro sap
         v_Return = WshShell.Run("""C:\Program Files (x86)\SAP\SapSetup\setup\SAL\SapLogon.s8l""", 1, False)

        pid = WaitForProcess("saplogon.exe", 7)
        'Se Loguea
        If pid > 0 Then
            WshShell.AppActivate pid
            SApLoguear NombreConexion, user, pass
         End If
End Function
Public Function SApLoguear(connection, user, password)
    If Not IsObject(Application1) Then
       Set SapGuiAuto = GetObject("SAPGUI")
       Set Application1 = SapGuiAuto.GetScriptingEngine
    End If
    If Not IsObject(connection) Then
      On Error Resume Next
      Set connection = Application1.OpenConnection(connection, True)
    End If
    If Not IsObject(sapsession) Then
       Set sapsession = connection.Children(0)
    End If
    If IsObject(WScript) Then
       WScript.ConnectObject Application1, "on"
    End If
'    sapsession.findById("wnd[0]/usr/txtRSYST-BNAME").Text = user
'    sapsession.findById("wnd[0]/usr/pwdRSYST-BCODE").Text = password
'    sapsession.findById("wnd[0]/usr/txtRSYST-LANGU").Text = "es"
'    sapsession.findById("wnd[0]").sendVKey 0
'    On Error GoTo 0
End Function
  Public Function WaitForProcess(imageName, tries)
      Dim wql, process
      wql = "SELECT ProcessId FROM Win32_Process WHERE Name = '" & imageName & "'"
      WaitForProcess = 0
      Set WMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

      While tries > 0 And WaitForProcess = 0
          For Each process In WMI.ExecQuery(wql)
              WaitForProcess = process.processId
          Next
          If WaitForProcess = 0 Then
              '''WScript.sleep 1000
              tries = tries - 1
          End If
      Wend
  End Function


Public Sub Ir_a_TX(transactionCode)
  'session.findById("wnd[0]").maximize
  session.findById("wnd[0]/tbar[0]/okcd").Text = transactionCode
  session.findById("wnd[0]").sendVKey 0
End Sub

Public Sub SAPMenuAcceso_DestildarTodo()
session.findById("wnd[0]/usr/tblSAPLMGMWTAB_CONT_0100").getAbsoluteRow(0).Selected = False
session.findById("wnd[0]/usr/tblSAPLMGMWTAB_CONT_0100").getAbsoluteRow(1).Selected = False
session.findById("wnd[0]/usr/tblSAPLMGMWTAB_CONT_0100").getAbsoluteRow(2).Selected = False
session.findById("wnd[0]/usr/tblSAPLMGMWTAB_CONT_0100").getAbsoluteRow(3).Selected = False
session.findById("wnd[0]/usr/tblSAPLMGMWTAB_CONT_0100").getAbsoluteRow(4).Selected = False
session.findById("wnd[0]/usr/tblSAPLMGMWTAB_CONT_0100").getAbsoluteRow(5).Selected = False
session.findById("wnd[0]/usr/tblSAPLMGMWTAB_CONT_0100").getAbsoluteRow(6).Selected = False
End Sub

Public Sub SAPMenuAcceso_TildarChecks(opcionesATildar)
  Dim x, check, value
  For x = 1 To Len(opcionesATildar)
    check = Mid(opcionesATildar, x, 1)
    If capitan = 1 Then MsgBox "tildo " & check
    Select Case check
      Case "1":   value = "0"          ' DATOS BASICOS
      Case "2":   value = "1"          ' CATALOGACION
      Case "3":   value = "2"          ' COMPRAS
      Case "4":   value = "3"          ' VENTAS
      Case "5":   value = "4"          ' LOGISTICA CENTRO DISTRIBUCION
      Case "6":   value = "5"          ' LOGISTICA TIENDA
      Case "7":   value = "6"          ' POS TPV
    End Select
    session.findById("wnd[0]/usr/tblSAPLMGMWTAB_CONT_0100").getAbsoluteRow(value).Selected = True
  Next
End Sub

Public Sub SAPMenuAcceso_PredeterminarVistas()
    session.findById("wnd[0]/usr/btnSAVESICHTEN").press
    'session.findById("wnd[0]/usr/btnSAVEORGEBENEN").press
End Sub

Public Function CheckWarnin()
                    warnin = session.findById("wnd[0]/sbar").messagetype
                        Do Until warnin <> "W"
                        session.findById("wnd[0]").sendVKey 0
                            DoEvents 'se añada el 13 de Julio para probar...
                        warnin = "" 'se añada el 13 de Julio para probar...
                        warnin = session.findById("wnd[0]/sbar").messagetype
                        Loop
End Function

Public Function Error_BarradeEstadoSAP(window)

  If (session.findById("" & window & "").messagetype = "E" Or session.findById("" & window & "").messagetype = "W") And (session.findById("" & window & "").messagenumber > 0) Then
      If capitan = 1 Then MsgBox "Error Insalvable. Ocurrio un error." & vbCr & session.findById("" & window & "").Text & vbCr & vbCr & "Continuo con el siguiente...", vbCritical, "ERROR GENERIC"
      comentariodeSAP = session.findById("wnd[0]/sbar").Text
      seguirProceso = 0
   Else
      If capitan = 1 Then MsgBox "No hay errores"
      seguirProceso = 1
  End If
  'esto es todo nuevo para los errores al cotabilizar
  If Left(session.findById("" & window & "").Text, 7) = "Errores" Then 'por si encuentra errores al contabilizar
            comentariodeSAP = session.findById("wnd[0]/sbar").Text
            seguirProceso = 0
  End If
  Error_BarradeEstadoSAP = seguirProceso
End Function

Public Function EliminarAcentos(texto)
    If capitan = 1 Then MsgBox texto
        texto = Replace(texto, Chr(225), "a")
        texto = Replace(texto, Chr(233), "e")
        texto = Replace(texto, Chr(237), "i")
        texto = Replace(texto, Chr(243), "o")
        texto = Replace(texto, Chr(250), "u")
    EliminarAcentos = texto
    Cortotexto = texto
End Function
Public Function IniciaScriptSAPAbierto()
On Error Resume Next
If session Is Nothing Then
  Set objSAPGui = GetObject("SAPGUI")
  Set App = objSAPGui.GetScriptingEngine
  Set connection = App.Children(0)
  Set session = connection.Children(0)
ElseIf session2 Is Nothing Then
  Set objSAPGui = GetObject("SAPGUI")
  Set App = objSAPGui.GetScriptingEngine
  Set connection = App.Children(1)
  Set session2 = connection.Children(0)
End If
   On Error GoTo 0
End Function
Public Function Analisaambiente(UnidadNegocio)
      If UnidadNegocio = "SUPER PERU" Then
         Analisaambiente = "RP9"
      ElseIf UnidadNegocio = "PARIS PERU" Then
         Analisaambiente = "PP0"
      ElseIf UnidadNegocio = "SUPER CHILE" Then
         Analisaambiente = "P03"
      ElseIf Left(UnidadNegocio, 4) = "EASY" Then 'si los primeros digitos es igual a Easy entonces va a PE0
           Analisaambiente = "PE0"
      End If
End Function
Public Function Controlar_ContadorPunterodeCambio(UnidadNegocio, Contadorsolicitud)
On Error Resume Next
On Error GoTo 0
seguirProceso = 1
If Contadorsolicitud = "" Then Contadorsolicitud = 0 'nuevo para que no salga en el primer intento
Set ACA = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("B1")
Set Search = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("B:B").Find(What:=CLng(Date) & UnidadNegocio, After:=ACA, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not (Search) Is Nothing Then
        PunteroConta = Search.Offset(0, 2)
        Search.Offset(0, 2) = PunteroConta + Contadorsolicitud
                If UCase(Search.Offset(0, 3)) = "CORTA" Then
                    Controlar_ContadorPunterodeCambio = 0
                Else
                    Controlar_ContadorPunterodeCambio = 1
                End If
        Search.Offset(0, 2) = PunteroConta
        Else 'CREAR LA NUEVA LINEA
        WBMacroCris.Sheets("ModifPunteros de Cambio").Range("A1048576").End(xlUp).Offset(1, 0).value = Date 'REVISAR SI ES VALUE O VALUES
        WBMacroCris.Sheets("ModifPunteros de Cambio").Range("B1048576").End(xlUp).Offset(1, 0).value = CLng(Date) & UnidadNegocio
        WBMacroCris.Sheets("ModifPunteros de Cambio").Range("C1048576").End(xlUp).Offset(1, 0).value = UnidadNegocio
        WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D1048576").End(xlUp).Offset(1, 0).value = 0
        WBMacroCris.Sheets("ModifPunteros de Cambio").Range("E1048576").End(xlUp).Offset(0, 0).Copy
        WBMacroCris.Sheets("ModifPunteros de Cambio").Range("E1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
        application.CutCopyMode = False
                PunteroConta = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D1048576").End(xlUp).Offset(0, 0).value
                WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D1048576").End(xlUp).Offset(0, 0).value = PunteroConta + Contadorsolicitud
                If UCase(WBMacroCris.Sheets("ModifPunteros de Cambio").Range("E1048576").End(xlUp).Offset(0, 0).value) = "CORTA" Then
                    Controlar_ContadorPunterodeCambio = 0
                Else
                    Controlar_ContadorPunterodeCambio = 1
                End If
            WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D1048576").End(xlUp).Offset(0, 0).value = PunteroConta
        End If

End Function
Sub AgregarPunteroCambio(UniNego)
If PunteroCambio = "NO" Or PunteroCambio = "" Then
Exit Sub
End If
Dim sArrayOrg(5) As String
'Dim valor As String
I = 0
    If UCase(Left(UniNego, 4)) = "EASY" Or UCase(Left(UniNego, 4)) = "BLAI" Then
            Ir_a_TX ("/NSE16")
            session.findById("wnd[0]/usr/ctxtDATABROWSE-TABLENAME").Text = "MVKE"
            session.findById("wnd[0]").sendVKey 0
            session.findById("wnd[0]/usr/ctxtI1-LOW").Text = SKU
            session.findById("wnd[0]/usr/ctxtI3-LOW").Text = "10"
            session.findById("wnd[0]/tbar[1]/btn[8]").press 'presiono F8
                Set aw = session.ActiveWindow()
                Set GRID1 = aw.findById("wnd[0]/usr/cntlGRID1/shellcont/shell")
                            For I = 0 To GRID1.RowCount - 1
                                    sArrayOrg(I) = GRID1.getCellValue(I, "VKORG")
                            Next
    Else
    sArrayOrg(I) = UniNego
    End If
         valor = Join(sArrayOrg, "-")
         
            If InStr(valor, "1000") Then
                FilaPunter = FilaPuntero("EASY ARGENTINA")
                WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value + 1
            End If
                If InStr(valor, "2000") Then
                    FilaPunter = FilaPuntero("EASY CHILE")
                    WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value + 1
                End If
                    If InStr(valor, "2500") Then
                        FilaPunter = FilaPuntero("EASY COLOMBIA")
                        WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value + 1
                    End If
                        If InStr(valor, "8000") Then
                            FilaPunter = FilaPuntero("BLAISTEN ARGENTINA")
                            WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value + 1
                        End If
                If InStr(valor, "SUPER CHILE") Then
                        FilaPunter = FilaPuntero("SUPER CHILE")
                        WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value + 1
                    ElseIf InStr(valor, "SUPER PERU") Then
                        FilaPunter = FilaPuntero("SUPER PERU")
                        WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value + 1
                    ElseIf InStr(valor, "SUPER PARIS") Then
                        FilaPunter = FilaPuntero("SUPER PARIS")
                        WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("D" & FilaPunter).value + 1
                End If
Erase sArrayOrg ' limpio la variable
End Sub
Public Function FilaPuntero(UniNego)
Set ACA = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("B1")
Set Search = WBMacroCris.Sheets("ModifPunteros de Cambio").Range("B:B").Find(What:=CLng(Date) & UnidadNegocio, After:=ACA, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
FilaPuntero = Search.Row
End Function

Public Function Control_AmbienteAbierto()
On Error Resume Next
AmbienteAbierto = ""
    session.findById("wnd[0]/tbar[0]/okcd").Text = "/nmm43"
    session.findById("wnd[0]").sendVKey 0
    session.findById("wnd[0]/mbar/menu[4]/menu[11]").Select
    SAPabierto = session.findById("wnd[1]/usr/txtSTATUS_INFO-DATABASE_HOST").Text
    'DoEvents
        Select Case SAPabierto
            Case "phw-db1":  Control_AmbienteAbierto = "RP9"
            Case "pe0-db01":  Control_AmbienteAbierto = "PE0"
            Case "pp0-db":  Control_AmbienteAbierto = "PP0"
            Case "best-db":  Control_AmbienteAbierto = "P03"
        End Select
  session.findById("wnd[0]/tbar[0]/okcd").Text = "/nmm42"
  session.findById("wnd[0]").sendVKey 0
End Function
Public Sub Kill_SAP() 'elimino sap desde el administrador de tareas por si tengo alguno abiertooooooooooo
    Dim oServ As Object, cProc As Object, oProc As Object
    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("Select * from Win32_Process")
        For Each oProc In cProc
            If oProc.Name = "saplogon.exe" Then
                errReturnCode = oProc.Terminate
            End If
        Next
End Sub
Public Function CloseSession() 'cierro la sesion de SAp que tengo abierta forzandolo...
    Dim e As Integer
    e = 1
        With session
                .findById("wnd[0]").Close
                On Error Resume Next
                Do Until e = 0
                  .findById("wnd[1]/usr/btnSPOP-OPTION1").press
                  e = Err.Number
                Loop
                On Error GoTo 0
        End With
    Set session = Nothing
    application.IgnoreRemoteRequests = False
    application.DisplayAlerts = True
End Function
Public Function IniciaScriptSAP() 'inicio con While y no le termino el loop hasta que arranque SAP
On Error Resume Next

If session Is Nothing Then 'Revisar por q lo acabo de agregar
  Set objSAPGui = GetObject("SAPGUI")
  Set App = objSAPGui.GetScriptingEngine
  Set connection = App.Children(0)
  Set session = connection.Children(0)
    If session Is Nothing Then GoTo continuar:
    Exit Function
End If

continuar:
Intentos = 0
    'Dim SapGuiAuto As Variant, app As Variant, connection As Variant
    If Not IsObject(App) Then
        Set SapGuiAuto = Nothing
        On Error Resume Next
            Do While SapGuiAuto Is Nothing
                Set SapGuiAuto = GetObject("SAPGUI")
                Esperar (10)
                Intentos = Intentos + 1
                    If Intentos = 10 Then
                    IniciaScriptSAP = False
                    Exit Function
                    End If
                    
            Loop
        On Error GoTo 0
        Set App = SapGuiAuto.GetScriptingEngine
    End If
On Error Resume Next

    Set connection = Nothing
        Do While connection Is Nothing
            Set connection = App.Children(0)
        Loop
    Set session = Nothing
        Do While session Is Nothing
            Set session = connection.Children(0)
        Loop
On Error GoTo 0
End Function
Public Function GrArticuloParis_ZVTRA_RECLMART()
application.ScreenUpdating = False
Dim Wb As Workbook
Dim ws As Worksheet
Dim Libro As String
Set Wb = Workbooks.Add
Set ws = Sheets(1)
    ws.Cells(1, 1).value = "articulo"
    ws.Cells(1, 2).value = "Grupo de artículo"
    ws.Cells(1, 3).value = "OC"
    ws.Cells(1, 4).value = "Tabla de Asignación"
    ws.Cells(1, 5).value = "Grupo de Compras"
    
    ws.Cells(2, 1).value = SKU
    ws.Cells(2, 2).value = Fdatonuevo
    ws.Cells(2, 3).value = "X"
    ws.Cells(2, 4).value = "X"
    ws.Cells(2, 5).value = Left(Fdatonuevo, 3)
Wb.SaveAs Filename:=ThisWorkbook.Path & "\Paris.txt", FileFormat:=xlText, CreateBackup:=False 'lo guardo como texto
Wb.Close True
LibroParis = ThisWorkbook.Path & "\Paris.txt"

End Function

Public Function Ctrl_SKU_Existente(SKU)
On Error Resume Next
'IniciaScriptSAP
session.findById("wnd[0]/tbar[0]/okcd").Text = "/nse16"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxtDATABROWSE-TABLENAME").Text = "MARA"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxtI1-LOW").Text = SKU
session.findById("wnd[0]/tbar[1]/btn[31]").press
Contador = session.findById("wnd[1]/usr/txtG_DBCOUNT").Text
    If Contador = 0 Then
        Ctrl_SKU_Existente = 0
        Else
        Ctrl_SKU_Existente = 1
    End If
End Function
Public Function EASY_RegionalSI_NO(UnidadNegocio) 'revisar si es regional o no..
Dim FinEINA As String
Dim FINMVKE As String
Dim Regional As String
Dim NegocioOK As String
Dim MatGenerico As Boolean
Dim Control As Workbook
On Error Resume Next
'IniciaScriptSAP
Ir_a_TX ("/nSE16")
session.findById("wnd[0]/usr/ctxtDATABROWSE-TABLENAME").Text = "MARA"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxtI1-LOW").Text = SKU
session.findById("wnd[0]").sendVKey 8
TpMat = session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell").getCellValue(0, "ATTYP")
    If TpMat = "02" Then MatGenerico = True 'para los casos en que sea variante
    If TpMat = "" Then EASY_RegionalSI_NO = "SKUNOEXISTE": Exit Function 'no existe el material en la mara...

Ir_a_TX ("/nSQVI")
session.findById("wnd[0]/usr/ctxtRS38R-QNUM").Text = "REG_SINO_EINA" ' si no existe la sqvi se muere...
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]").sendVKey 8
session.findById("wnd[0]/usr/ctxtSP$00002-LOW").Text = SKU
    If MatGenerico = True Then session.findById("wnd[0]/usr/ctxtSP$00001-LOW").Text = Left(SKU, Len(SKU) - 3)
session.findById("wnd[0]").sendVKey 8
Set aw = session.ActiveWindow()
Set GRID1 = aw.findById("wnd[0]/usr/cntlCONTAINER/shellcont/shell")
Set Control = Workbooks.Add
I = 0
            For I = 0 To GRID1.RowCount - 1
            Control.Sheets(1).Range("A" & I + 1).value = GRID1.getCellValue(I, "MATNR")
            Control.Sheets(1).Range("B" & I + 1).value = GRID1.getCellValue(I, "LIFNR")
            Control.Sheets(1).Range("C" & I + 1).value = GRID1.getCellValue(I, "INFNR")
            Control.Sheets(1).Range("D" & I + 1).value = GRID1.getCellValue(I, "MEINS")
            Control.Sheets(1).Range("E" & I + 1).value = GRID1.getCellValue(I, "RELIF")
            Control.Sheets(1).Range("F" & I + 1).value = GRID1.getCellValue(I, "EKORG")
            Next

Ir_a_TX ("/NSE16") 'va a la segunda SQVI
session.findById("wnd[0]/usr/ctxtDATABROWSE-TABLENAME").Text = "MVKE" ' si no existe la sqvi se muere...
session.findById("wnd[0]").sendVKey 0

session.findById("wnd[0]/usr/ctxtI1-LOW").Text = SKU
session.findById("wnd[0]/usr/ctxtI3-LOW").Text = "10"
session.findById("wnd[0]").sendVKey 8
Set aw = session.ActiveWindow()
Set GRID1 = aw.findById("wnd[0]/usr/cntlGRID1/shellcont/shell")
I = 0
            For I = 0 To GRID1.RowCount - 1
            Control.Sheets(1).Range("M" & I + 1).value = GRID1.getCellValue(I, "MATNR")
            Control.Sheets(1).Range("N" & I + 1).value = GRID1.getCellValue(I, "VKORG")
            Next
Set aw = Nothing
Set GRID1 = Nothing

'completar las formulas
FinEINA = Control.Sheets(1).Range("A1048576").End(xlUp).Row
FINMVKE = Control.Sheets(1).Range("M1048576").End(xlUp).Row

Control.Sheets(1).Range("P1").value = UnidadNegocio
Control.Sheets(1).Range("U1").value = "RegionalSINO"
Control.Sheets(1).Range("V1").value = "EASY CHILE"
Control.Sheets(1).Range("W1").value = "EASY ARGENTINA"
Control.Sheets(1).Range("X1").value = "EASY COLOMBIA"
Control.Sheets(1).Range("Y1").value = "BLAISTEN ARGENTINA"
Control.Sheets(1).Range("U2").value = "=IF(CONCATENATE(RC[1],RC[2],RC[3],RC[4])=R[-1]C[-5],""NO"",""SI"")" 'nueva
Control.Sheets(1).Range("V2").value = "=IFERROR(IF(AND(VLOOKUP(R1C,C7,1,0)=R1C,VLOOKUP(R1C,C15,1,0)=R1C),R1C,""""),"""")"
Control.Sheets(1).Range("V2").Copy
Control.Sheets(1).Range("W2:Y2").PasteSpecial xlPasteAll
Control.Sheets(1).Range("G1").value = "=IF(RC[-1]=2001,""EASY CHILE"",IF(RC[-1]=2002,""EASY CHILE"",IF(RC[-1]=1001,""EASY ARGENTINA"",IF(RC[-1]=1002,""EASY ARGENTINA"",IF(RC[-1]=3001,""EASY COLOMBIA"",IF(RC[-1]=3002,""EASY COLOMBIA"",IF(RC[-1]=8001,""BLAISTEN ARGENTINA"",IF(RC[-1]=8002,""BLAISTEN ARGENTINA""))))))))"
Control.Sheets(1).Range("O1").value = "=IF(RC[-1]=2000,""EASY CHILE"",IF(RC[-1]=1000,""EASY ARGENTINA"",IF(RC[-1]=2500,""EASY COLOMBIA"",IF(RC[-1]=8000,""BLAISTEN ARGENTINA""))))"
Control.Sheets(1).Range("G1").Copy
Control.Sheets(1).Range("G1:G" & FinEINA).PasteSpecial xlPasteAll
Control.Sheets(1).Range("O1").Copy
Control.Sheets(1).Range("O1:O" & FINMVKE).PasteSpecial xlPasteAll
Control.Sheets(1).Range("T1").value = "UnidaddeNegocioOK"
Control.Sheets(1).Range("T2").value = "=IFERROR(IF(HLOOKUP(R[-1]C[-4],RC[2]:RC[6],1,0)=R[-1]C[-4],""OK""),"""")"
application.CutCopyMode = False

NegocioOK = Control.Sheets(1).Range("T2").value
    If NegocioOK = "" Then EASY_RegionalSI_NO = "UNNEGOCIOERROR": Control.Close False: Exit Function
Regional = Control.Sheets(1).Range("U2").value
Control.Close False 'Cierro el libro que abri sin guardar
    If Regional = "SI" Then
    EASY_RegionalSI_NO = True
    ElseIf Regional = "NO" Then
    EASY_RegionalSI_NO = False
    End If
Set Control = Nothing
End Function



Public Function BuscarFilaArchivo(WBMacroCris As Workbook, NombreArchivo)
        Set ACA = WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("C13")
        Set Search = WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("C:C").Find(What:=NombreArchivo, After:=ACA, LookIn:=xlFormulas _
                , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                If Not (Search) Is Nothing Then
                I = Search.Row
                NumberSolicitud = Search.Offset(0, -1)
                HoraEntrada = Search.Offset(0, 3)
                Else
                MsgBox ("No se encuentra el nombre de archivo")
                End If
    BuscarFilaArchivo = I
End Function
Public Function Esperar(segundos)
On Error Resume Next
application.Wait (Now + TimeValue("00:00:0" & segundos))
End Function
Public Function ControlarPestañasROJO(Wb As Workbook)
ControlarPestañasROJO = True
    For I = 1 To Wb.Sheets.Count
    ColorPestaña = Sheets(I).Tab.Color
        If ColorPestaña = vbRed Then
        ControlarPestañasROJO = False
        Exit Function
        End If
    Next
End Function
Public Function TotalModificaciones(Wb As Workbook) 'completa Columna AE del Log
On Error Resume Next
Total_Modif = application.WorksheetFunction.CountA(Wb.Sheets("Modificaciones").Range("D13:D1048576"))
Total_AdicionVariante = application.WorksheetFunction.CountA(Wb.Sheets("Adicion de Variantes").Range("D13:D1048576"))
Total_RegistroInfo = application.WorksheetFunction.CountA(Wb.Sheets("Registro Info").Range("E13:E1048576"))
Total_Marca = application.WorksheetFunction.CountA(Wb.Sheets("Marca").Range("E13:E1048576"))
Total_Jerarquia = application.WorksheetFunction.CountA(Wb.Sheets("Jerarquia").Range("D13:D1048576"))
Total_Volumetria = application.WorksheetFunction.CountA(Wb.Sheets("Volumetria").Range("D13:D1048576"))
Total_LibroPedido = application.WorksheetFunction.CountA(Wb.Sheets("Libros de Pedido").Range("D13:D1048576"))
Total_OF3 = application.WorksheetFunction.CountA(Wb.Sheets("Oferta_3_Minutos").Range("D13:D1048576"))
Total_CambioGrArt = application.WorksheetFunction.CountA(Wb.Sheets("CambioGr.Articulo").Range("D13:D1048576"))
Total_ModifSellos = application.WorksheetFunction.CountA(Wb.Sheets("Modif Sellos Ley 20606").Range("D13:D1048576"))

TotalModificaciones = Total_Modif + Total_AdicionVariante + Total_RegistroInfo + Total_Marca + _
                      Total_Jerarquia + Total_Volumetria + Total_LibroPedido + Total_OF3 + Total_CambioGrArt + Total_ModifSellos

End Function
Public Function TotalModificacionesErrones(Wb As Workbook) 'completa Columna AF del Log
On Error Resume Next
TotalError_Modif = application.WorksheetFunction.CountA(Wb.Sheets("Modificaciones").Range("A13:A1048576"))
TotalError_AdicionVariante = application.WorksheetFunction.CountA(Wb.Sheets("Adicion de Variantes").Range("A13:A1048576"))
TotalError_RegistroInfo = application.WorksheetFunction.CountA(Wb.Sheets("Registro Info").Range("A13:A1048576"))
TotalError_Marca = application.WorksheetFunction.CountA(Wb.Sheets("Marca").Range("A13:A1048576"))
TotalError_Jerarquia = application.WorksheetFunction.CountA(Wb.Sheets("Jerarquia").Range("A13:A1048576"))
TotalError_Volumetria = application.WorksheetFunction.CountA(Wb.Sheets("Volumetria").Range("A13:A1048576"))
TotalError_LibroPedido = application.WorksheetFunction.CountA(Wb.Sheets("Libros de Pedido").Range("A13:A1048576"))
TotalError_OF3 = application.WorksheetFunction.CountA(Wb.Sheets("Oferta_3_Minutos").Range("A13:A1048576"))
TotalError_CambioGrArt = application.WorksheetFunction.CountA(Wb.Sheets("CambioGr.Articulo").Range("A13:A1048576"))
TotalError_ModifSellos = application.WorksheetFunction.CountA(Wb.Sheets("Modif Sellos Ley 20606").Range("A13:A1048576"))

TotalModificacionesErrones = TotalError_Modif + TotalError_AdicionVariante + TotalError_RegistroInfo + TotalError_Marca + _
                      TotalError_Jerarquia + TotalError_Volumetria + TotalError_LibroPedido + TotalError_OF3 + TotalError_CambioGrArt + TotalError_ModifSellos
End Function


Sub Ctrl_MkDIR_CarpetaDias(Ruta As String) 'agrega las carpetas de los dias...

Fechahoy = Replace(Date, "/", ".")
FechaManana = Replace(Date + 1, "/", ".")

 If Dir(Ruta & "\" & Fechahoy, vbDirectory) = "" Then
    MkDir Ruta & "\" & Fechahoy
 End If
 If Dir(Ruta & "\" & FechaManana, vbDirectory) = "" Then
    MkDir Ruta & "\" & FechaManana
 End If
End Sub

Public Function CloseSystem() 'Cerrar SAP P03 de Manera Segura
On Error Resume Next
Dim application
If Not IsObject(application) Then
   Set SapGuiAuto = GetObject("SAPGUI")
   Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
   Set connection = application.Children(0)
End If
If Not IsObject(session) Then
   Set session = connection.Children(0)
End If
If IsObject(WScript) Then
   WScript.ConnectObject session, "on"
   WScript.ConnectObject application, "on"
End If
'close SAP
Ir_a_TX ("/nmm42")
    Dim e As Integer
    e = 1
        With session
                .findById("wnd[0]").Close
                On Error Resume Next
                Do Until e = 0
                  .findById("wnd[1]/usr/btnSPOP-OPTION1").press
                  e = Err.Number
                  cont = cont + 1
                    If cont = 100 Then GoTo Salir
                Loop
Salir:
                On Error GoTo 0
        End With
    Set session = Nothing
    'application.IgnoreRemoteRequests = False
    'application.DisplayAlerts = True
'Eliminar SAP completamente desde Win
Kill_SAP
End Function
Public Function MsgRevision(mensajerevision, iRow)
On Error Resume Next
WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("BC" & FilaMonitor).value = WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("BC" & FilaMonitor).value & "-" & mensajerevision & " Fila " & iRow
Revision = True
End Function

Public Function Ctrl_Form(Wb)
On Error Resume Next
Ctrl_Form = False
Select Case UCase(Wb.Sheets("Modificaciones").Range("XFD1").value)
    Case "FORM_MODIF_SUPERCHILE": Ctrl_Form = True
    Case "FORM_MODIF_EASYBLAISTEN": Ctrl_Form = True
    Case "FORM_MODIF_SUPERPERU": Ctrl_Form = True
    Case "FORM_MODIF_SUPERPARIS": Ctrl_Form = True
End Select
'Ctrl_Form = True
End Function

Public Function Completar_LogMonitor(Formulario, FilaMonitor, Wb As Workbook)
If Revision = True Then
WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("AB" & FilaMonitor).value = True
Else
WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("AB" & FilaMonitor).value = False
End If

    WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("Y" & FilaMonitor).value = Formulario 'Completa Observaciones de Archivo
    WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("AE" & FilaMonitor).value = TotalModificaciones(Wb)
    WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("AF" & FilaMonitor).value = TotalModificacionesErrones(Wb)
    WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("AG" & FilaMonitor).value = WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("AE" & FilaMonitor).value - WBMacroCris.Sheets("Mon_Modificaciones_Regional").Range("AF" & FilaMonitor).value
End Function


Sub Kill_Files(Ruta)
Dim strRuta As String
strRuta = Ruta
If Right(strRuta, 1) <> "\" Then strRuta = strRuta & "\"
On Error Resume Next
'función KILL: para el borrado de una carpeta y los ficheros qeu hubiera en ella
Kill strRuta & "*.*"    ' borra la totalidad de archivos
'Kill strRuta & "*.xl*"    ' borraría la totalidad de archivos solo de Excel
End Sub

Attribute VB_Name = "F_MetricaDiaria"
Public Function Hacer_Metrica_Modificaciones(fila As Integer, origen As Workbook, destino As Workbook)
    Dim wbOrigen As Excel.Workbook
    Dim wbDestino As Excel.Workbook
    Dim wsOrigen As Excel.Worksheet
    Dim wsDestino As Excel.Worksheet
    
    Set wsOrigen = origen.Worksheets("Modificaciones") 'la hoja de modificaciones del archivo tratado
    Set wsDestino = destino.Worksheets("Modificaciones") 'la hoja de modificaciones de la metrica de Marta
    
fini = wsDestino.Range("B1048576").End(xlUp).Row + 1
    wsOrigen.Range("A" & fila).Copy
    wsDestino.Range("A" & fini).PasteSpecial Paste:=xlPasteValues
    
    wsOrigen.Range("C" & fila, "W" & fila).Copy 'Copia la Fila tratada del Formulario
    wsDestino.Range("C" & fini).PasteSpecial Paste:=xlPasteValues 'pega Valores en la Metrica de Marta
    wsDestino.Range("Z" & fini) = UnidadNegocio
    wsDestino.Range("AA" & fini) = NumberSolicitud
    wsDestino.Range("AB" & fini) = Now
    wsDestino.Range("B" & fini) = Date 'esto es para q ponga la fecha en la columna A antes era date

    Wbmetricadiaria.Save 'guardo la metrica de modificaciones

End Function

Public Function Hacer_Metrica_RegistroInfo(fila As Integer, origen As Workbook, destino As Workbook)
    Dim wbOrigen As Excel.Workbook
    Dim wbDestino As Excel.Workbook
    Dim wsOrigen As Excel.Worksheet
    Dim wsDestino As Excel.Worksheet

    Set wsOrigen = origen.Worksheets("Registro Info") 'la hoja de modificaciones del archivo tratado
    Set wsDestino = destino.Worksheets("Registro Info") 'la hoja de modificaciones de la metrica de Marta

fini = wsDestino.Range("B1048576").End(xlUp).Row + 1
    wsOrigen.Range("A" & fila).Copy
    wsDestino.Range("A" & fini).PasteSpecial Paste:=xlPasteValues
    
    wsOrigen.Range("C" & fila, "W" & fila).Copy 'Copia la Fila tratada del Formulario
    wsDestino.Range("C" & fini).PasteSpecial Paste:=xlPasteValues 'pega Valores en la Metrica de Marta
    wsDestino.Range("Z" & fini) = UnidadNegocio
    wsDestino.Range("AA" & fini) = NumberSolicitud
    wsDestino.Range("AB" & fini) = Now
    wsDestino.Range("B" & fini) = Date 'esto es para q ponga la fecha en la columna A antes era date

Wbmetricadiaria.Save 'guardo la metrica de modificaciones

End Function

Public Function Hacer_Metrica_GrArticulos(fila As Integer, origen As Workbook, destino As Workbook) 'revisar
    Dim wbOrigen As Excel.Workbook
    Dim wbDestino As Excel.Workbook
    Dim wsOrigen As Excel.Worksheet
    Dim wsDestino As Excel.Worksheet
    
    Set wsOrigen = origen.Worksheets("CambioGr.Articulo") 'la hoja de Gr.Articulos del archivo tratado
    Set wsDestino = destino.Worksheets("CambioGr.Articulo") 'la hoja de Gr.Articulos de la metrica de Marta
    
fini = wsDestino.Range("B1048576").End(xlUp).Row + 1
    wsOrigen.Range("A" & fila).Copy
    wsDestino.Range("A" & fini).PasteSpecial Paste:=xlPasteValues
    
    wsOrigen.Range("C" & fila, "G" & fila).Copy 'Copia la Fila tratada del Formulario
    wsDestino.Range("C" & fini).PasteSpecial Paste:=xlPasteValues 'pega Valores en la Metrica de Marta
    wsDestino.Range("Z" & fini) = UnidadNegocio
    wsDestino.Range("AA" & fini) = NumberSolicitud
    wsDestino.Range("AB" & fini) = Now
    wsDestino.Range("B" & fini) = Date 'esto es para q ponga la fecha en la columna A antes era date
    'wbmetricadiaria.Save 'guardo la metrica de modificaciones
End Function

Public Function Hacer_Metrica_Marcas(fila As Integer, origen As Workbook, destino As Workbook)
    Dim wbOrigen As Excel.Workbook
    Dim wbDestino As Excel.Workbook
    Dim wsOrigen As Excel.Worksheet
    Dim wsDestino As Excel.Worksheet

    Set wsOrigen = origen.Worksheets("Marca") 'la hoja de modificaciones del archivo tratado
    Set wsDestino = destino.Worksheets("Marca") 'la hoja de modificaciones de la metrica de Marta

fini = wsDestino.Range("B1048576").End(xlUp).Row + 1
    wsOrigen.Range("A" & fila).Copy
    wsDestino.Range("A" & fini).PasteSpecial Paste:=xlPasteValues
    
    wsOrigen.Range("C" & fila, "W" & fila).Copy 'Copia la Fila tratada del Formulario
    wsDestino.Range("C" & fini).PasteSpecial Paste:=xlPasteValues 'pega Valores en la Metrica de Marta
    wsDestino.Range("Z" & fini) = UnidadNegocio
    wsDestino.Range("AA" & fini) = NumberSolicitud
    wsDestino.Range("AB" & fini) = Now
    wsDestino.Range("B" & fini) = Date 'esto es para q ponga la fecha en la columna A antes era date

Wbmetricadiaria.Save 'guardo la metrica de modificaciones
End Function

Public Function Hacer_Metrica_Volumetria(fila As Integer, origen As Workbook, destino As Workbook)
    Dim wbOrigen As Excel.Workbook
    Dim wbDestino As Excel.Workbook
    Dim wsOrigen As Excel.Worksheet
    Dim wsDestino As Excel.Worksheet

    Set wsOrigen = origen.Worksheets("Volumetria") 'la hoja de modificaciones del archivo tratado
    Set wsDestino = destino.Worksheets("Volumetria") 'la hoja de modificaciones de la metrica de Marta

fini = wsDestino.Range("B1048576").End(xlUp).Row + 1
    wsOrigen.Range("A" & fila).Copy
    wsDestino.Range("A" & fini).PasteSpecial Paste:=xlPasteValues
    
    wsOrigen.Range("C" & fila, "W" & fila).Copy 'Copia la Fila tratada del Formulario
    wsDestino.Range("C" & fini).PasteSpecial Paste:=xlPasteValues 'pega Valores en la Metrica de Marta
    wsDestino.Range("Z" & fini) = UnidadNegocio
    wsDestino.Range("AA" & fini) = NumberSolicitud
    wsDestino.Range("AB" & fini) = Now
    wsDestino.Range("B" & fini) = Date 'esto es para q ponga la fecha en la columna A antes era date
Wbmetricadiaria.Save 'guardo la metrica de modificaciones
End Function

Public Function Hacer_Metrica_OF3Minutos(fila As Integer, origen As Workbook, destino As Workbook)
    Dim wbOrigen As Excel.Workbook
    Dim wbDestino As Excel.Workbook
    Dim wsOrigen As Excel.Worksheet
    Dim wsDestino As Excel.Worksheet

    Set wsOrigen = origen.Worksheets("Oferta_3_Minutos") 'la hoja de modificaciones del archivo tratado
    Set wsDestino = destino.Worksheets("Oferta_3_Minutos") 'la hoja de modificaciones de la metrica de Marta

fini = wsDestino.Range("B1048576").End(xlUp).Row + 1
    wsOrigen.Range("A" & fila).Copy
    wsDestino.Range("A" & fini).PasteSpecial Paste:=xlPasteValues
    
    wsOrigen.Range("C" & fila, "W" & fila).Copy 'Copia la Fila tratada del Formulario
    wsDestino.Range("C" & fini).PasteSpecial Paste:=xlPasteValues 'pega Valores en la Metrica de Marta
    wsDestino.Range("Z" & fini) = UnidadNegocio
    wsDestino.Range("AA" & fini) = NumberSolicitud
    wsDestino.Range("AB" & fini) = Now
    wsDestino.Range("B" & fini) = Date 'esto es para q ponga la fecha en la columna A antes era date
Wbmetricadiaria.Save 'guardo la metrica de modificaciones
End Function

Public Function Hacer_Metrica_LeydeSellado(fila As Integer, origen As Workbook, destino As Workbook)
    Dim wbOrigen As Excel.Workbook
    Dim wbDestino As Excel.Workbook
    Dim wsOrigen As Excel.Worksheet
    Dim wsDestino As Excel.Worksheet

    Set wsOrigen = origen.Worksheets("Modif Sellos Ley 20606") 'la hoja de Ley de Sellado del archivo tratado
    Set wsDestino = destino.Worksheets("Modif Sellos Ley 20606") 'la hoja de Ley de Sellado de la metrica de Marta

fini = wsDestino.Range("B1048576").End(xlUp).Row + 1
    wsOrigen.Range("A" & fila).Copy
    wsDestino.Range("A" & fini).PasteSpecial Paste:=xlPasteValues
    
    wsOrigen.Range("C" & fila, "H" & fila).Copy 'Copia la Fila tratada del Formulario
    wsDestino.Range("C" & fini).PasteSpecial Paste:=xlPasteValues 'pega Valores en la Metrica de Marta
    wsDestino.Range("Z" & fini) = UnidadNegocio
    wsDestino.Range("AA" & fini) = NumberSolicitud
    wsDestino.Range("AB" & fini) = Now
    wsDestino.Range("B" & fini) = Date 'esto es para q ponga la fecha en la columna A antes era date
Wbmetricadiaria.Save 'guardo la metrica de modificaciones
End Function

Attribute VB_Name = "G_Encripter_Decripter"
'Sub cris()
'a = Encrypt("cristian")
'b = Decrypt("o|s}~s‡x")
'
'End Sub

Public Function Encrypt(strvalue As String) As String
Const LowerAlpha    As String = "abcdefghijklmnopqrstuvwxyz"
Const LowerSub      As String = "zebrascdfghijklmnopqtuvwxy" 'zebras
Const UpperAlpha    As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const UpperSub      As String = "ZEBRASCDFGHIJKLMNOPQTUVWXY" 'ZEBRAS
Dim lngi            As Long
Dim lngE            As Long
Dim strEncrypt      As String
Dim strLetter       As String
If strvalue & "" = "" Then Exit Function
For lngi = 1 To Len(strvalue)
    strLetter = Mid(strvalue, lngi, 1)
    Select Case Asc(strLetter)
        Case 65 To 90 'Uppercase
            'Find position in alpha string
            For lngE = 1 To Len(UpperAlpha)
                If Mid(UpperAlpha, lngE, 1) = strLetter Then GoTo USub
            Next
USub:
            strEncrypt = strEncrypt & Mid(UpperSub, lngE, 1)
        Case 97 To 122 'Lowercase
            'Find position in alpha string
            For lngE = 1 To Len(LowerAlpha)
                If Mid(LowerAlpha, lngE, 1) = strLetter Then GoTo LSub
            Next
LSub:
            strEncrypt = strEncrypt & Mid(LowerSub, lngE, 1)
        Case Else 'Do not substitute
            strEncrypt = strEncrypt & strLetter
    End Select
Next
'Now pass this string through ROT13 for another tier of security
For lngi = 1 To Len(strEncrypt)
    Encrypt = Encrypt & Chr(Asc(Mid(strEncrypt, lngi, 1)) + 13)
Next
End Function
Public Function Decrypt(strvalue As String) As String
Const LowerAlpha    As String = "abcdefghijklmnopqrstuvwxyz"
Const LowerSub      As String = "zebrascdfghijklmnopqtuvwxy" 'zebras
Const UpperAlpha    As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const UpperSub      As String = "ZEBRASCDFGHIJKLMNOPQTUVWXY" 'ZEBRAS
Dim lngi            As Long
Dim lngE            As Long
Dim strDecrypt      As String
Dim strLetter       As String
If strvalue & "" = "" Then Exit Function
'Reverse the ROT13 cipher
For lngi = 1 To Len(strvalue)
    strDecrypt = strDecrypt & Chr(Asc(Mid(strvalue, lngi, 1)) - 13)
Next
'Now reverse the encryption
For lngi = 1 To Len(strDecrypt)
    strLetter = Mid(strDecrypt, lngi, 1)
    Select Case Asc(strLetter)
        Case 65 To 90 'Uppercase
            'Find position in sub string
            For lngE = 1 To Len(UpperSub)
                If Mid(UpperSub, lngE, 1) = strLetter Then GoTo USub
            Next
USub:
            Decrypt = Decrypt & Mid(UpperAlpha, lngE, 1)
        Case 97 To 122 'Lowercase
            'Find position in sub string
            For lngE = 1 To Len(LowerSub)
                If Mid(LowerSub, lngE, 1) = strLetter Then GoTo LSub
            Next
LSub:
            Decrypt = Decrypt & Mid(LowerAlpha, lngE, 1)
        Case Else 'Do not substitute
            Decrypt = Decrypt & strLetter
    End Select
Next
End Function


Attribute VB_Name = "K_Access"
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 293888 bytes
SHA-256: d8758724066a0162dec48dcc9a8a1848c2da9f359cfbb9155169d20add5268d6
Detection
ClamAV: Xls.Macro.Obfuscation-9804250-0
Obfuscation or payload: unlikely

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