Malicious Office (OOXML) / .XLSX — malware analysis report

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

Option Explicit
Option Base 1
Public Sub Workbook_Open()
On Error GoTo ErrorHandler
Dim i As Long
Dim clsProperties As New BneVBAProperties
clsProperties.removeProperty "ICX_SESSION_ID"
AddReferences
RemoveRibbonProterties
setShowMainGroup False
setShowGraphGroup False
For i = 1 To ActiveWorkbook.Worksheets.count
On Error Resume Next
ActiveWorkbook.Worksheets(i).BneStartup
ActiveWorkbook.Worksheets(i).Activate
On Error GoTo 0
Next
ThisWorkbook.Saved = True
Exit Sub
ErrorHandler:
AddBneMsg BNE_ERROR, "Workbook_Open", "Error: " & Err.Number & " " & Err.Description
End Sub
Public Sub Workbook_Activate()
On Error GoTo ErrorHandler
AddReferences
ThisWorkbook.ActiveSheet.BneSheetActivate
Exit Sub
ErrorHandler:
AddBneMsg BNE_ERROR, "Workbook_Activate", "Error: " & Err.Number & " " & Err.Description
End Sub
Public Sub Workbook_Deactivate()
On Error GoTo ErrorHandler
ThisWorkbook.ActiveSheet.BneRemoveOracleMenu
Exit Sub
ErrorHandler:
AddBneMsg BNE_ERROR, "Workbook_Deactivate", "Error: " & Err.Number & " " & Err.Description
End Sub
Public Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo ErrorHandler
g_WorkbookSavedPreviously = ThisWorkbook.Saved
If g_WorkbookSavedPreviously = False And ThisWorkbook.FileFormat = xlExcel9795 Then
On Error Resume Next
Workbooks.Open ThisWorkbook.FullName, False, False, , , , , , , , False, , False
End If
Exit Sub
ErrorHandler:
AddBneMsg BNE_ERROR, "Workbook_BeforeSave", "Error: " & Err.Number & " " & Err.Description
End Sub
Public Sub AddReferences()
BneAddReference "VBIDE", "{0002E157-0000-0000-C000-000000000046}"
BneAddReference "MSForms", "{0D452EE1-E08F-101A-852E-02608C4D0BB4}"
BneAddReference "SHDocVw", "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}"
BneAddReference "MSHTML", "{3050F1C5-98B5-11CF-BB82-00AA00BDCE0B}"
BneAddReference "Office", "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}"
BneAddReference "VBA", "{000204EF-0000-0000-C000-000000000046}"
BneAddReference "Excel", "{00020813-0000-0000-C000-000000000046}"
BneAddReference "stdole", "{00020430-0000-0000-C000-000000000046}"
BneAddReference "Scripting", "{420B2830-E718-11CF-893D-00A0C9054228}"
If BneGETMSXMLVersion() >= 3 _
And CInt(Left(Application.Version, (InStr(1, Application.Version & ".", ".") - 1))) >= 9 Then
BneAddReference "MSXML3", "{F5078F18-C551-11D3-89B9-0000F81FE221}"
End If
End Sub


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

Option Explicit
Option Base 1
Const WEBADI_SHEET As String = "WebADI"
Const OSSCOOKIE = "PROD"
Const DOCUMENT_ONCLICK = "BneDocument_OnClick "
Const DOCUMENT_COMPLETE = "BneDocument_Complete "
Const PRODUCT_CODE_LABEL = "12.0.0.0"
Const PRODUCT_RELEASE_LABEL = "12.0.0.0: Friday Feburary 10, 2006"
Const VIEWER_VERSION = "$Revision: 120.93.12020000.44 $"
Const GENERATED_LANGUAGE = "ESA"
Const SERVLET_PATH = "http://ebs.chihuahua.gob.mx:8000/OA_HTML/"
Const APPLICATION_SERVICE = SERVLET_PATH & "BneApplicationService"
Const COMPONENT_SERVICE = SERVLET_PATH & "BneComponentService"
Const UPLOAD_SERVICE = SERVLET_PATH & "BneUploaderService"
Const DOWNLOAD_SERVICE = SERVLET_PATH & "BneDownloadService"
Const TRACE_LEVEL_DESCRIPTION = " ERROR"
Const DEBUG_FLAG = False
Const DEBUG_DOCUMENT = "c:\BneDebug-Document.xml"
Const DEBUG_MESSAGES = "c:\BneDebug-Messages.xml"
Const UPLOAD_DOCUMENT = "c:\Bne-Document.xml"
Const UPLOAD_MESSAGES = "c:\Bne-Messages.xml"
Const DOWNLOAD_DOCUMENT = "Bne-Document-Content.xml"
Const BNE_DOCUMENT_ID = "IEA2T7MTW14FFKL3WYAMH53LJUZLADD8VWGM9UPD"
Dim m_objHTMLDocument As HTMLDocument
Dim m_Browser As Object
Dim m_InterfaceColName As String
Dim m_InterfaceName As String
Dim m_flagRow As Boolean
Dim m_DocumentProcessor As String
Dim m_SessionState As Boolean
Dim m_SessionTicket As String
Dim m_StatusBarVisible As Boolean
Dim m_TicketNumber As Long
Dim intBrowserWidth As Integer
Dim intBrowserHeight As Integer
Dim comingFromDelete As Boolean
Dim BNEERROR As New BNEERROR
Dim m_objVBAUploader As BneVBAUploader
Dim m_col_InterfaceCols As Collection
Dim m_clsLayout As BneLayout
Dim m_LOVFlag As Boolean
Dim m_rowsInLines As Long
Dim m_PreviousSelection As Range
Dim m_blnUploadAll As Boolean
Dim m_newRibbonWorkbookPath As Collection
Public Sub BneOnCreateProcedure()
Me.name = WEBADI_SHEET
Call BneCreateLayout
Dim clsRowInserter As New BneRowInserter
clsRowInserter.protectSheet Me
Set clsRowInserter = Nothing
Dim objBneRibbon As BneRibbon
Dim strPath As String
Dim objParentRibbonWorkbookPaths As Collection
Set objParentRibbonWorkbookPaths = getParentRibbonWorkbookPaths
Set objBneRibbon = getBneRibbon
strPath = objBneRibbon.createMenuForWorkBook(ThisWorkbook)
objParentRibbonWorkbookPaths.add strPath
Set objBneRibbon = Nothing
Set objParentRibbonWorkbookPaths = Nothing
End Sub
Public Sub BneCreateOracleMenu()
If isRibbonCreateSuccess = True Then
EnableRibbonMainGroup
Exit Sub
End If
Dim strMenuTitle As String
Dim objWorkSheetMenuBar As Object
Set objWorkSheetMenuBar = Application.CommandBars("Worksheet Menu Bar")
Dim objMenu_231_ORACLE As Object
strMenuTitle = "Or&acle"
On Error Resume Next
objWorkSheetMenuBar.Controls(strMenuTitle).Delete
On Error GoTo 0
Set objMenu_231_ORACLE = objWorkSheetMenuBar.Controls.add(Type:=msoControlPopup, before:=8)
objMenu_231_ORACLE.caption = strMenuTitle
Dim objMenu_231_FILTERS As Object
strMenuTitle = "&Filtros"
Set objMenu_231_FILTERS = objMenu_231_ORACLE.Controls.add(Type:=msoControlPopup)
objMenu_231_FILTERS.caption = strMenuTitle
Dim objMenu_231_SHOW_FILTERS As Object
strMenuTitle = "&Mostrar Filtros"
Set objMenu_231_SHOW_FILTERS = objMenu_231_FILTERS.Controls.add
objMenu_231_SHOW_FILTERS.OnAction = Application.ActiveSheet.CodeName & ".BneShowFilters"
objMenu_231_SHOW_FILTERS.caption = strMenuTitle
Dim objMenu_231_HIDE_FILTERS As Object
strMenuTitle = "&Ocultar Filtros"
Set objMenu_231_HIDE_FILTERS = objMenu_231_FILTERS.Controls.add
objMenu_231_HIDE_FILTERS.OnAction = Application.ActiveSheet.CodeName & ".BneHideFilters"
objMenu_231_HIDE_FILTERS.caption = strMenuTitle
Dim objMenu_231_RESET_FILTERS As Object
strMenuTitle = "&Restablecer Filtros"
Set objMenu_231_RESET_FILTERS = objMenu_231_FILTERS.Controls.add
objMenu_231_RESET_FILTERS.OnAction = Application.ActiveSheet.CodeName & ".BneResetFilters"
objMenu_231_RESET_FILTERS.caption = strMenuTitle
Dim objMenu_231_LOV As Object
strMenuTitle = "&Lista de Valores"
Set objMenu_231_LOV = objMenu_231_ORACLE.Controls.add
objMenu_231_LOV.OnAction = Application.ActiveSheet.CodeName & ".BneDBLClick"
objMenu_231_LOV.caption = strMenuTitle
Dim objMenu_231_UPLOAD As Object
strMenuTitle = "&Cargar"
Set objMenu_231_UPLOAD = objMenu_231_ORACLE.Controls.add
objMenu_231_UPLOAD.OnAction = Application.ActiveSheet.CodeName & ".BneUploadDocument"
objMenu_231_UPLOAD.caption = strMenuTitle
Dim objMenu_231_UPLOADALL As Object
strMenuTitle = "&Cargar Todo"
Set objMenu_231_UPLOADALL = objMenu_231_ORACLE.Controls.add
objMenu_231_UPLOADALL.OnAction = Application.ActiveSheet.CodeName & ".BneUploadAll"
objMenu_231_UPLOADALL.caption = strMenuTitle
Dim objMenu_231_MONITOR As Object
strMenuTitle = "&Monitorear"
Set objMenu_231_MONITOR = objMenu_231_ORACLE.Controls.add
objMenu_231_MONITOR.OnAction = "'" & Application.ActiveSheet.CodeName & ".BneMonitor" & "'"
objMenu_231_MONITOR.caption = strMenuTitle
Dim objMenu_231_SWITCHRESP As Object
strMenuTitle = "Cambiar &Responsabilidad"
Set objMenu_231_SWITCHRESP = objMenu_231_ORACLE.Controls.add
objMenu_231_SWITCHRESP.OnAction = "'" & Application.ActiveSheet.CodeName & ".BneSwitchResponsibility" & "'"
objMenu_231_SWITCHRESP.caption = strMenuTitle
Dim objMenu_231_ABOUT As Object
strMenuTitle = "&Acerca de"
Set objMenu_231_ABOUT = objMenu_231_ORACLE.Controls.add
objMenu_231_ABOUT.OnAction = "'" & Application.ActiveSheet.CodeName & ".BneAbout" & "'"
objMenu_231_ABOUT.BeginGroup = True
objMenu_231_ABOUT.caption = strMenuTitle
BneSelectionChange_Menus Me.UsedRange
End Sub
Public Sub BneShowFilters()
Dim pDrawingObjects As Boolean
Dim pContents As Boolean
Dim pScenarios As Boolean

Dim TopRow As Long
Dim TopColumn As Long

Dim LinesRange As Range
Dim LinesBlockHdr As Range

Dim TipTextExists As Boolean
Dim HeaderOffset As Integer

Dim InterfaceCols As Collection

If Not AutoFilterMode Then
Application.ScreenUpdating = False
With Me
pDrawingObjects = .ProtectDrawingObjects
pContents = .ProtectContents
pScenarios = .ProtectScenarios
If Not pDrawingObjects And Not pContents And Not pScenarios Then
Else
.Unprotect
End If
End With
TopRow = ActiveWindow.VisibleRange.Row
TopColumn = ActiveWindow.VisibleRange.Column

Set InterfaceCols = BneGetVBAInterfaceCols
Set LinesRange = BneRetrieveLinesBlockRange(Me, InterfaceCols)

TipTextExists = BneIsLinesBlockHintDisplayed(InterfaceCols)
If TipTextExists Then
HeaderOffset = -2
Else
HeaderOffset = -1
End If

With Me
If Not LinesRange Is Nothing Then
Set LinesBlockHdr = Range(Cells(LinesRange.Row + HeaderOffset, LinesRange.Column), Cells(LinesRange.Rows(LinesRange.Rows.count).Row, LinesRange.Columns(LinesRange.Columns.count).Column))
LinesBlockHdr.AutoFilter

If TipTextExists Then
.Rows(LinesRange.Row - 1).Hidden = True
End If
End If

ActiveWindow.ScrollRow = TopRow
ActiveWindow.ScrollColumn = TopColumn
If .AutoFilterMode = False Then
.Protect DrawingObjects:=True, contents:=True, Scenarios:=True
End If
End With
End If

BneSelectionChange_Menus Me.UsedRange
End Sub
Public Function IsEnabled_231_SHOW_FILTERS() As Boolean
If Me.AutoFilterMode Then
IsEnabled_231_SHOW_FILTERS = False
Else
IsEnabled_231_SHOW_FILTERS = True
End If
End Function
Public Sub BneHideFilters()
Dim pDrawingObjects As Boolean
Dim pContents As Boolean
Dim pScenarios As Boolean

Dim TopRow As Long
Dim TopColumn As Long

Dim LinesRange As Range
Dim LinesBlockHdr As Range

Dim TipTextExists As Boolean
Dim HeaderOffset As Integer

Dim InterfaceCols As Collection

If AutoFilterMode Then
Application.ScreenUpdating = False
With Me
pDrawingObjects = .ProtectDrawingObjects
pContents = .ProtectContents
pScenarios = .ProtectScenarios
If Not pDrawingObjects And Not pContents And Not pScenarios Then
Else
.Unprotect
End If
End With
TopRow = ActiveWindow.VisibleRange.Row
TopColumn = ActiveWindow.VisibleRange.Column

Set InterfaceCols = BneGetVBAInterfaceCols
Set LinesRange = BneRetrieveLinesBlockRange(Me, InterfaceCols)

TipTextExists = BneIsLinesBlockHintDisplayed(InterfaceCols)
If TipTextExists Then
HeaderOffset = -2
Else
HeaderOffset = -1
End If

With Me
If Not LinesRange Is Nothing Then
Set LinesBlockHdr = Range(Cells(LinesRange.Row + HeaderOffset, LinesRange.Column), Cells(LinesRange.Rows(LinesRange.Rows.count).Row, LinesRange.Columns(LinesRange.Columns.count).Column))
LinesBlockHdr.AutoFilter

If TipTextExists Then
.Rows(LinesRange.Row - 1).Hidden = False
End If
End If

ActiveWindow.ScrollRow = TopRow
ActiveWindow.ScrollColumn = TopColumn
If .AutoFilterMode = False Then
.Protect DrawingObjects:=True, contents:=True, Scenarios:=True
End If
End With
End If

BneSelectionChange_Menus Me.UsedRange
End Sub
Public Function IsEnabled_231_HIDE_FILTERS() As Boolean
If Me.AutoFilterMode Then
IsEnabled_231_HIDE_FILTERS = True
Else
IsEnabled_231_HIDE_FILTERS = False
End If
End Function
Public Sub BneResetFilters()
Dim pDrawingObjects As Boolean
Dim pContents As Boolean
Dim pScenarios As Boolean

Dim LinesRange As Range

Dim InterfaceCols As Collection

If AutoFilterMode Then
Application.ScreenUpdating = False
With Me
pDrawingObjects = .ProtectDrawingObjects
pContents = .ProtectContents
pScenarios = .ProtectScenarios
If Not pDrawingObjects And Not pContents And Not pScenarios Then
Else
.Unprotect
End If

On Error Resume Next

.ShowAllData
End With

Set InterfaceCols = BneGetVBAInterfaceCols
If BneIsLinesBlockHintDisplayed(InterfaceCols) Then

Set LinesRange = BneRetrieveLinesBlockRange(Me, InterfaceCols)
If Not LinesRange Is Nothing Then
Me.Rows(LinesRange.Row - 1).Hidden = True
End If
End If

With Me
If Not pDrawingObjects And Not pContents And Not pScenarios Then
Else
.Protect DrawingObjects:=True, contents:=True, Scenarios:=True
End If
End With
End If
End Sub
Public Function IsEnabled_231_RESET_FILTERS() As Boolean
If Me.AutoFilterMode Then
IsEnabled_231_RESET_FILTERS = True
Else
IsEnabled_231_RESET_FILTERS = False
End If
End Function
Public Function IsVisible_231_UPLOAD() As Boolean
Dim objProperties As New BneVBAProperties
Dim objProperty As BneVBAProperty
objProperties.setSheet Me
Set objProperty = objProperties.getProperty("contentgroupupload")
If Not objProperty Is Nothing Then
IsVisible_231_UPLOAD = BneGetBooleanValue(objProperty.value)
Else
IsVisible_231_UPLOAD = True
End If
End Function
Public Function IsVisible_231_UPLOADALL() As Boolean
Dim objProperties As New BneVBAProperties
Dim objProperty As BneVBAProperty
Dim intSheetCnt As Integer
Set objProperty = objProperties.getProperty("contentsheetcount")
If Not objProperty Is Nothing Then
intSheetCnt = CInt(objProperty.value)
End If
If intSheetCnt <= 1 Then
IsVisible_231_UPLOADALL = False
Else
objProperties.setSheet Me
Set objProperty = objProperties.getProperty("contentgroupupload")
If Not objProperty Is Nothing Then
IsVisible_231_UPLOADALL = BneGetBooleanValue(objProperty.value)
End If
End If
End Function
Private Sub BneSelectionChange_Menus(ByVal Target As Range)
On Error Resume Next
Dim strMenuTitle As String
Dim objWorkSheetMenuBar As Object
Set objWorkSheetMenuBar = Application.CommandBars("Worksheet Menu Bar")
Dim objMenu_231_ORACLE As Object
strMenuTitle = "Or&acle"
Set objMenu_231_ORACLE = objWorkSheetMenuBar.Controls(strMenuTitle)
Dim objMenu_231_FILTERS As Object
strMenuTitle = "&Filtros"
Set objMenu_231_FILTERS = objMenu_231_ORACLE.Controls(strMenuTitle)
Dim objMenu_231_SHOW_FILTERS As Object
strMenuTitle = "&Mostrar Filtros"
Set objMenu_231_SHOW_FILTERS = objMenu_231_FILTERS.Controls(strMenuTitle)
objMenu_231_SHOW_FILTERS.Enabled = IsEnabled_231_SHOW_FILTERS
Dim objMenu_231_HIDE_FILTERS As Object
strMenuTitle = "&Ocultar Filtros"
Set objMenu_231_HIDE_FILTERS = objMenu_231_FILTERS.Controls(strMenuTitle)
objMenu_231_HIDE_FILTERS.Enabled = IsEnabled_231_HIDE_FILTERS
Dim objMenu_231_RESET_FILTERS As Object
strMenuTitle = "&Restablecer Filtros"
Set objMenu_231_RESET_FILTERS = objMenu_231_FILTERS.Controls(strMenuTitle)
objMenu_231_RESET_FILTERS.Enabled = IsEnabled_231_RESET_FILTERS
Dim objMenu_231_UPLOAD As Object
strMenuTitle = "&Cargar"
Set objMenu_231_UPLOAD = objMenu_231_ORACLE.Controls(strMenuTitle)
objMenu_231_UPLOAD.Visible = IsVisible_231_UPLOAD
Dim objMenu_231_UPLOADALL As Object
strMenuTitle = "&Cargar Todo"
Set objMenu_231_UPLOADALL = objMenu_231_ORACLE.Controls(strMenuTitle)
objMenu_231_UPLOADALL.Visible = IsVisible_231_UPLOADALL
End Sub
Public Sub BneRemoveOracleMenu()
On Error Resume Next
If isRibbonCreateSuccess = True Then
DisableRibbonMainGroup
End If
Dim strMenuTitle As String
Dim objCellPopUp As CommandBar
Dim i As Integer
Dim objWorkSheetMenuBar As Object
Set objWorkSheetMenuBar = Application.CommandBars("Worksheet Menu Bar")
strMenuTitle = "Or&acle"
objWorkSheetMenuBar.Controls(strMenuTitle).Delete
Set objCellPopUp = CommandBars("Cell")
If Not objCellPopUp Is Nothing Then
For i = objCellPopUp.Controls.count To 1 Step -1
If Left(objCellPopUp.Controls(i).Tag, 9) = "mnuOracle" Then
objCellPopUp.Controls(i).Delete
End If
Next i
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim objCellPopUp As CommandBar
Dim objButton As CommandBarButton
Dim i As Integer
Dim strMenuTitle As String
On Error GoTo ErrorHandler
Set objCellPopUp = CommandBars("Cell")
If Not objCellPopUp Is Nothing Then
For i = objCellPopUp.Controls.count To 1 Step -1
If Left(objCellPopUp.Controls(i).Tag, 9) = "mnuOracle" Then
objCellPopUp.Controls(i).Delete
End If
Next i
strMenuTitle = "&Lista de Valores"
Set objButton = objCellPopUp.Controls.add()
objButton.BeginGroup = True
objButton.caption = strMenuTitle
objButton.Tag = "mnuOracle_231_LOV_CONTEXT"
objButton.OnAction = Application.ActiveSheet.CodeName & ".BneDBLClick"
End If
Exit Sub
ErrorHandler:
AddBneMsg BNE_ERROR, "Worksheet_BeforeRightClick", "Error: " & Err.Number & " " & Err.Description
End Sub
Public Sub CreateLayout()
Dim bDisplayStatusBar As Boolean
Dim localPicFile As String
Dim oPicture As Shape
Dim lft As Double
Dim tp As Double
Dim isProtected As Boolean
On Error GoTo LayoutError
bDisplayStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
ActiveWindow.DisplayOutline = True
With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlLeft
End With
Selection.ApplyOutlineStyles
Application.ScreenUpdating = False
Application.Interactive = False
Set m_clsLayout = New BneLayout
m_clsLayout.render Me
Set m_clsLayout = Nothing
isProtected = Me.ProtectContents
If isProtected Then
setLayoutProtected True
End If
Application.ScreenUpdating = True
Application.Interactive = True
Application.StatusBar = ""
Application.DisplayStatusBar = bDisplayStatusBar
Exit Sub
LayoutError:
AddBneMsg BNE_ERROR, "Sheet.CreateLayout", "Error: " & Err.Number & " " & Err.Description
Application.ScreenUpdating = True
Application.Interactive = True
Application.DisplayStatusBar = bDisplayStatusBar
Set m_clsLayout = Nothing
End Sub
Public Sub BneUploadCancel()
Dim oParams As New BneVBAParameters
If Not m_Browser Is Nothing Then
oParams.add "bne:apiVersion", "1.0"
oParams.add "bne:page", "BneAsyncUpload"
oParams.add "event", "bne:asyncJobCancel"
oParams.add "bne:documentId", "IEA2T7MTW14FFKL3WYAMH53LJUZLADD8VWGM9UPD"
If Not m_objVBAUploader Is Nothing Then
oParams.add "bne:uploadJob", CStr(m_objVBAUploader.JobID)
End If
m_Browser.NavigatePost APPLICATION_SERVICE, oParams
End If
End Sub
Public Sub BneUploadBegin(ByRef objHTMLDocument As Object)
Dim colSheets As New Collection
Dim objBook As Object
Dim objSheet As Object
Dim clsProperties As New BneVBAProperties
Dim clsProperty As BneVBAProperty
Dim strContentID As String
BneAddReference "Scripting", "{420B2830-E718-11CF-893D-00A0C9054228}"
If m_blnUploadAll = True Then
clsProperties.setSheet Me
Set clsProperty = clsProperties.getProperty("contentidentifier")
If Not clsProperty Is Nothing Then
strContentID = clsProperty.value
End If
For Each objBook In Workbooks
For Each objSheet In objBook.Worksheets
clsProperties.setSheet objSheet
Set clsProperty = clsProperties.getProperty("contentidentifier")
If Not clsProperty Is Nothing Then
If clsProperty.value = strContentID Then
Set clsProperty = clsProperties.getProperty("contentgroupsequence")
If Not clsProperty Is Nothing Then
If Len(clsProperty.value) > 0 Then
Set clsProperty = clsProperties.getProperty("contentgroupupload")
If Not clsProperty Is Nothing Then
If BneGetBooleanValue(clsProperty.value) = True Then
colSheets.add objSheet
End If
End If
End If
End If
End If
End If
Next
Next
Else
colSheets.add Me
End If
Call BneProcessingBegin(True)
Set m_objVBAUploader = New BneVBAUploader
Set m_objVBAUploader.Sheets = colSheets
BneSetupNewUpload objHTMLDocument
m_Browser.addEventCallBack "BneUploadCancel", "BNE:BROWSERCLOSE", Me
m_objVBAUploader.BneUploadBegin
Dim lTicketNumber As Long
Dim strMsgHeader As String
strMsgHeader = "Error"
lTicketNumber = m_objVBAUploader.JobID
If lTicketNumber = -1 Then
If m_objVBAUploader.Status = m_objVBAUploader.UPL_ERROR Then
objHTMLDocument.body.innerHTML = BneBrowser.WebBrowser_DocumentComplete_ERROR_MESSAGE
Else 'Show the standard error page with last error in response xml.
Call m_Browser.ErrorMessage(strMsgHeader, m_objVBAUploader.text, m_objVBAUploader.cause, m_objVBAUploader.action)
objHTMLDocument.body.innerHTML = m_Browser.WebBrowser_DocumentComplete_ERROR_MESSAGE
End If
ElseIf lTicketNumber = 0 Then
Call m_Browser.ErrorMessage(strMsgHeader, m_objVBAUploader.text, m_objVBAUploader.cause, m_objVBAUploader.action)
objHTMLDocument.body.innerHTML = m_Browser.WebBrowser_DocumentComplete_ERROR_MESSAGE
Else
objHTMLDocument.all("bne:uploadJob").value = CStr(lTicketNumber)
Dim oForm As Object
Set oForm = objHTMLDocument.all("BneAsyncUploadPageSend")
oForm.submit
End If
End Sub
Public Sub BneSetupNewUpload(ByRef objHTMLDocument As Object)
Dim commonParamForm As Object
Dim integratorParamForm As Object
Dim commonParams As BneVBAParameters
Dim integratorParams As BneVBAParameters
Dim documentId As String
ResetMsgs
Set commonParamForm = objHTMLDocument.all("bne:icxId")
Set commonParams = BneExtractParams(commonParamForm)
commonParams.add "bne:documentId", Me.BneGetDocumentId
commonParams.add "bne:servicePath", Me.BneGetServletPath
commonParams.add "bne:language", Me.BneGetGeneratedLanguage
commonParams.add "bne:apiVersion", "1.1"
commonParams.add "bne:requestType", "asynchronous"
Set integratorParamForm = objHTMLDocument.all("integratorParamForm")
Set integratorParams = BneExtractParams(integratorParamForm)
If UCase(objHTMLDocument.all("bne:rows").getAttribute("VALUE")) = "ALL" Then
m_objVBAUploader.FlaggedRowsOnly = False
Else
m_objVBAUploader.FlaggedRowsOnly = True
End If
Set m_objVBAUploader.CommonUploadParams = commonParams
End Sub
Private Sub BneUploadComplete(ByRef objHTMLDocument As Object)
Dim commonParamForm As Object
Dim commonParams As BneVBAParameters
Dim integratorParams As BneVBAParameters
m_Browser.removeEventCallBack "BNE:BROWSERCLOSE"
Set commonParamForm = objHTMLDocument.all("bne:icxId")
Set commonParams = BneExtractParams(commonParamForm)
commonParams.add "bne:documentId", Me.BneGetDocumentId
commonParams.add "bne:language", Me.BneGetGeneratedLanguage
commonParams.add "bne:servicePath", Me.BneGetServletPath
m_objVBAUploader.BneUploadComplete
If m_objVBAUploader.Status = m_objVBAUploader.UPL_ERROR Then
If GetMsgTypeCount(BNE_ERROR) > 0 Then
objHTMLDocument.body.innerHTML = BneBrowser.WebBrowser_DocumentComplete_ERROR_MESSAGE
Else 'Show the standard error page
objHTMLDocument.body.innerHTML = BneBrowser.WebBrowser_DocumentComplete_ERROR_MESSAGE
End If
End If
Set m_objVBAUploader = Nothing
Call BneProcessingEnd
End Sub
Private Sub BneUploadError(ByRef objHTMLDocument As Object)
If m_Browser Is Nothing Then
Else
Dim oParams As New BneVBAParameters
Set oParams = BneGetUploadParams()
If Not m_objVBAUploader Is Nothing Then
oParams.add "bne:uploadJob", CStr(m_objVBAUploader.JobID)
End If
objHTMLDocument.parentWindow.Status = ""
m_Browser.addEventCallBack "BneUploadError", "ERROR", Me
m_Browser.NavigatePost APPLICATION_SERVICE, oParams
End If
End Sub
Private Sub BneUploadClose(ByRef objHTMLDocument As Object)
Set m_objVBAUploader = Nothing
BneProcessingEnd
End Sub
Public Sub RowsToUpload(ByRef FlaggedRows() As Long, FlaggedRowsOnly As Boolean, Optional NotEmptyRows As Boolean = False)
Dim UploadRows As Variant
UploadRows = Me.Range("BNE_UPLOAD")
GetUploadRows Me, UploadRows, FlaggedRows, FlaggedRowsOnly, NotEmptyRows
End Sub
Private Sub BneXML()
Dim colSheets As New Collection
colSheets.add Me
Set m_objVBAUploader = New BneVBAUploader
Set m_objVBAUploader.Sheets = colSheets
m_objVBAUploader.BneUploadBegin
Dim objDocument As Object
Set objDocument = createDOMDocument()
Dim objLayout As New BneLayout
Dim objUploadStructure As New BneUploadLayout
objUploadStructure.createUploadXML colSheets, objLayout, objDocument, True
objDocument.Save (DEBUG_DOCUMENT)
Set objDocument = Nothing
Set objLayout = Nothing
Set colSheets = Nothing
End Sub
Public Sub BneCreateLayout()
Dim initialRange As Range
On Error Resume Next
Application.EnableEvents = False
CreateLayout
BneSetSession True, g_icxSessionID
Application.EnableEvents = True
setConstantsAndFormulas ActiveSheet.Range("LINE")
m_rowsInLines = ActiveSheet.Range("LINE").Rows.count
MoveToLinesBlock ActiveSheet
BneSheetActivate
End Sub
Public Sub BneSheetActivate()
On Error GoTo ErrorHandler
BneCreateOracleMenu
m_rowsInLines = ActiveSheet.Range("LINE").Rows.count
Exit Sub
ErrorHandler:
AddBneMsg BNE_ERROR, "BneSheetActivate", "Error: " & Err.Number & " " & Err.Description
End Sub
Public Sub BneStartup()
BneSetSession
m_LOVFlag = False
End Sub
Public Sub BneSetSession(Optional sessionState As Boolean, Optional sessionTicket As String)
On Error Resume Next
If sessionTicket <> "" Then
m_SessionState = sessionState
m_SessionTicket = sessionTicket
Else
m_SessionState = False
m_SessionTicket = ""
End If
End Sub
Public Function BneGetUploadParams() As Object
Dim oParams As New BneVBAParameters
Dim dataParameters As String
Dim sParamVal As String
oParams.add "bne:apiVersion", "1.0"
oParams.add "bne:page", "BneAsyncUpload"
oParams.add "bne:integrator", "101:JOURNALS_120"
oParams.add "gl:ledger", ColumnValue(Me, "GL_INTERFACE_LEDGER_ID")
oParams.add "bne:organization", ColumnValue(Me, "GL_INTERFACE_ORGANIZATION")
oParams.add "bne:actualflag", "A"
sParamVal = "Y"
oParams.add "bne:validation", sParamVal
sParamVal = "FLAGGED"
oParams.add "bne:rows", sParamVal
sParamVal = "Y"
oParams.add "bne:import", sParamVal
sParamVal = "N"
oParams.add "bne:importPost", sParamVal
sParamVal = "N"
oParams.add "bne:postUnbalanced", sParamVal
sParamVal = "N"
oParams.add "bne:importSummary", sParamVal
sParamVal = "GLXBDENT_J,GLXJEENT_A,GLXJEENT_E,GLXJIRUN"
oParams.add "bne:required_form_function", sParamVal
sParamVal = "NOIMPORT"
oParams.add "bne:importFlex", sParamVal
sParamVal = "N"
oParams.add "bne:mrc", sParamVal
Set BneGetUploadParams = oParams
End Function
Private Sub BneUploadDocument()
m_blnUploadAll = False
Call BneUploadCommon
End Sub
Private Sub BneUploadCommon()
Dim oParams As New BneVBAParameters
Set oParams = BneGetUploadParams()
Dim strMsgHeader As String
Dim strMsgBody As String
Dim strMsgAction1 As String
Dim strMsgAction2 As String
strMsgHeader = "Error"
strMsgBody = "Los resultados de la carga no se pueden desplegar."
strMsgAction1 = "Esto se debi" & ChrW(243) & " a una falla de la red. Deje abierta esta ventana para que se hagan m" & ChrW(225) & "s intentos para desplegar los resultados de carga."
strMsgAction2 = "P" & ChrW(243) & "ngase en contacto con el administrador de sistema si persiste este problema."
Set m_Browser = New BneBrowser
BneDefaultBrowser m_Browser
Call m_Browser.ErrorMessage(strMsgHeader, strMsgBody, strMsgAction1, strMsgAction2)
m_Browser.addEventCallBack "BneUploadBegin", "ASYNCUPLOADBEGIN", Me
m_Browser.addEventCallBack "BneUploadComplete", "ASYNCUPLOADCOMPLETE", Me
m_Browser.addEventCallBack "BneUploadError", "ERROR", Me
m_Browser.addEventCallBack "BneUploadClose", "CLOSE", Me
m_Browser.NavigatePost APPLICATION_SERVICE, oParams
m_Browser.Show
End Sub
Private Sub BneUploadAll()
m_blnUploadAll = True
Call BneUploadCommon
End Sub
Public Sub BneMonitor()
Dim oParams As New BneVBAParameters
oParams.add "bne:apiVersion", "1.0"
oParams.add "bne:page", "BneOAMonitor"
NavigatePost APPLICATION_SERVICE, oParams
End Sub
Private Sub BneMsgBox(oXML As Object)
Dim oParams As New BneVBAParameters
oParams.add "bne:apiVersion", "1.0"
oParams.add "bne:page", "BneMsgBox"
On Error Resume Next
oParams.add "bne:messagexml", "<message>" & oXML.xml & "</message>"
On Error GoTo 0
NavigatePost APPLICATION_SERVICE, oParams
End Sub
Public Sub BneAbout()
Dim oParams As New BneVBAParameters
oParams.add "bne:apiVersion", "1.0"
oParams.add "bne:page", "BneHelpAbout"
NavigatePost APPLICATION_SERVICE, oParams
End Sub
Public Sub BneSwitchResponsibility()
Dim oParams As New BneVBAParameters
oParams.add "bne:apiVersion", "1.0"
oParams.add "bne:page", "BneOASwitchResp"
NavigatePost APPLICATION_SERVICE, oParams
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
On Error Resume Next
BneDBLClick
Cancel = True
End Sub
Private Sub BneDBLClick()
On Error Resume Next
Dim strArgDocProcessor As String: Dim strArgInterfaceName As String: Dim strArgInterfaceColName As String: Dim strArgQueryString As String
Dim FieldName As String
Dim lsInterfaceColName As String
Dim flagData(1) As String
Dim oParams As New BneVBAParameters
Dim objCol As BneVBAInterfaceCol
Set objCol = GetBneVBAInterfaceColForRange(Me, ActiveCell)
If Not objCol Is Nothing Then
If objCol.ValComponent <> "" And BneIsReadOnly(ActiveCell, Me) Then
MsgBox "Los campos de sólo lectura no se pueden cambiar.", vbCritical
GoTo error
End If
End If
If Not Application.Intersect(ActiveCell, Me.Names("BNE_UPLOAD").RefersToRange) Is Nothing Then
If ActiveCell.value = "x" Then
GoTo error
End If
End If
intBrowserWidth = 350
intBrowserHeight = 500
lsInterfaceColName = GetBneInterfaceColNameOfRange(Me, Range(ActiveCell.Address))
FieldName = GetBneNameOfRange(Me, Range(ActiveCell.Address))
If Len(lsInterfaceColName) > 0 Then
oParams.add "bne:apiVersion", "1.1"
oParams.add "bne:documentId", BneGetDocumentId
Select Case lsInterfaceColName
Case "GL_INTERFACE_LEDGER_ID"
LEDGER_IDDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "TABLE"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_LEDGER_NAME"
strArgInterfaceColName = "LEDGER_ID"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_USER_JE_CATEGORY_NAME"
USER_JE_CATEGORY_NAMEDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "TABLE"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:OA_CATEGORY"
strArgInterfaceColName = "USER_JE_CATEGORY_NAME"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_USER_JE_SOURCE_NAME"
USER_JE_SOURCE_NAMEDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "TABLE"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:OA_SOURCE"
strArgInterfaceColName = "USER_JE_SOURCE_NAME"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_ACCOUNTING_DATE"
ACCOUNTING_DATEDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "TABLE"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:OA_ACCOUNTING_DATE"
strArgInterfaceColName = "ACCOUNTING_DATE"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT1"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT2"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT9"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT10"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT3"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT7"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT4"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT5"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT6"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT8"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT15"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT14"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT12"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT11"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
Case "GL_INTERFACE_SEGMENT13"
ACCOUNTDetails oParams, strArgDocProcessor, strArgInterfaceName
strArgDocProcessor = "KEYDFF"
strArgInterfaceName = "GL_INTERFACE"
oParams.add "bne:component", "101:GL_FLEX"
strArgInterfaceColName = "ACCOUNT_FLEX_FIELD"
BneBrowseDocument strArgDocProcessor, strArgInterfaceName, strArgInterfaceColName, COMPONENT_SERVICE, oParams, intBrowserHeight, intBrowserWidth
End Select
ElseIf Len(FieldName) > 0 Then
If FieldName = "BNE_MESSAGES" Then
If ColumnValue(Me, "BNE_MESSAGES") <> "" Then
oParams.add "bne:apiVersion", "1.0"
oParams.add "bne:page", "BneMsgBox"
oParams.add "bne:messagexml", "<message>" & ColumnValue(Me, "BNE_MESSAGES_HIDDEN") & "</message>"
NavigatePost APPLICATION_SERVICE, oParams
End If
ElseIf FieldName = "BNE_UPLOAD" Then
If Range(ActiveCell.Address) = "O" Then
Range(ActiveCell.Address) = ""
Else
Range(ActiveCell.Address) = "O"
End If
End If
…