Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 4dbb8d722f589dc8…

MALICIOUS

Office (OOXML)

115.6 KB Created: 2019-06-10 18:03:49 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2021-07-07
MD5: 023ba89aaac080ba4c4ef123b70cc457 SHA-1: 2d40e5bbaca0a9fccc7e52e6bba07a3f368d8d8f SHA-256: 4dbb8d722f589dc8c02172802ba35fc10b6567bae57365767b37ce8cca1ca988
248 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1059.001 PowerShell T1218.011 Signed Binary Proxy Execution: Rundll32

The sample is an Excel document containing VBA macros that utilize WScript.Shell and PowerShell. The presence of critical heuristics like 'Shell() call in VBA', 'WScript.Shell usage', and 'PowerShell reference in VBA' strongly indicates that the macro is designed to execute arbitrary commands. The VBA code likely downloads and executes a second-stage payload, a common technique for initial access and further compromise.

Heuristics 6

  • VBA project inside OOXML medium 4 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
        'ExCMD = Shell(PCommand & tPAth & ExCommand & " " & ShellParameter)
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        Dim wsh As Object
    Set wsh = VBA.CreateObject("WScript.Shell")
    Dim waitOnReturn As Boolean: waitOnReturn = True
  • PowerShell reference in VBA critical OLE_VBA_PS
    PowerShell reference in VBA
    Matched line in script
    Attribute VB_Name = "PowershellScripts"
Sub CreateSchema()
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
           Set fst = CreateObject("ADODB.Stream")
       fst.Type = 2
  • Hidden worksheet (veryHidden, hidden) low OOXML_HIDDEN_SHEET
    Excel workbook contains 3 hidden sheet(s) — hidden sheets are commonly used to conceal macro code, staging data, or intermediate payload construction

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) 62902 bytes
SHA-256: dd5be0403bf9ed34bd5a8b215ccb4da479c2d53ac09489c9df88ca688de0e675
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 = "ConnectionSetup"
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 = "ResetWKB"


Sub ResetWorkBookCleanup()
    Dim xWs As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "ConnectionSetup" Then
            Sheets(xWs.Name).Visible = True
            xWs.Delete
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub



Sub DeleteDNMXLRow()
Dim lColumn As Long
Dim iCntr As Long
lColumn = 16384
For iCntr = lColumn To 1 Step -1
    If Cells(1, iCntr) = "DNMXLRow" Then
        Columns(iCntr).Delete
    End If
Next
End Sub


Attribute VB_Name = "ButtonSaved"
Option Explicit

Type ButtonSizeType
    topPosition As Single
    leftPosition As Single
    height As Single
    width As Single
    sfont As Single
End Type

Public myButton As ButtonSizeType

Sub GetButtonSize(cb As MSForms.CommandButton)
' Save original button size to solve windows bug that changes the button size to
' adjust to screen resolution, when not in native resolution mode of screen
    myButton.topPosition = cb.Top
    myButton.leftPosition = cb.Left
    myButton.height = cb.height
    myButton.width = cb.width
    myButton.sfont = cb.FontSize
    
End Sub

Sub SetButtonSize(cb As MSForms.CommandButton)
' Restore original button size to solve windows bug that changes the button size to
' adjust to screen resolution, when not in native resolution mode of screen
    cb.Top = myButton.topPosition
    cb.Left = myButton.leftPosition
    cb.height = myButton.height
    cb.width = myButton.width
    cb.FontSize = myButton.sfont
End Sub


Attribute VB_Name = "CreateWorkSheets"
Function CheckIfSheetExists(SheetName As String) As Boolean
      CheckIfSheetExists = False
      For Each WS In Worksheets
        If SheetName = WS.Name Then
          CheckIfSheetExists = True
          Exit Function
        End If
      Next WS
End Function

Public Sub GetSqlDataForWorksheets(EntityName As String)

    
    Dim tServer As String
    Dim tWorkstation As String
    Dim tDatabase As String
    Dim trDatabase As String
    Dim tDataset As String
    Dim SH As Worksheet
    Dim wsht As Worksheet
    Dim QT As QueryTable
    Dim oQT As QueryTable
    Dim sConn As String
    Dim sSql As String
    'Dim EntityName As String

    '************************************************************************
    'Turn off the screen updating and auto calculation (performance upgrade?)
    '************************************************************************
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    
    '**************************************************************************
    'Turn off the Display Alerts. This allows overwrite of old Data Excel Files
    '**************************************************************************
    Application.DisplayAlerts = False
    
    tServer = ConnectionSetup.Range("B1").Value
    tWorkstation = ConnectionSetup.Range("B2").Value
    tDatabase = ConnectionSetup.Range("B3").Value
    trDatabase = ConnectionSetup.Range("B4").Value
    tDataset = ConnectionSetup.Range("B5").Value
    'EntityName = "Equipment"
    
    
    '************************************************
    'Write the Connection Information into a variable
    '************************************************
    sConn = "OLEDB;Provider=SQLOLEDB.1;"
    sConn = sConn & "Trusted_Connection=Yes;"
    sConn = sConn & "Initial Catalog=" & tDatabase & ";"
    sConn = sConn & "Data Source=" & tServer & ";"
    sConn = sConn & "Workstation ID=" & tWorkstation & ";"
            
    For Each wsht In Worksheets
        If wsht.Name = EntityName Then
            Set SH = wsht
        End If
    Next
   
    If SH Is Nothing Then
        Set SH = Sheets.Add(After:=Worksheets("tmpEntities"))
        SH.Name = EntityName
     End If
   
    '**************************************************
    'Clear out all of the query tables in the worksheet
    '**************************************************
    For Each QT In SH.QueryTables
        QT.Delete
    Next QT
    
    SH.AutoFilterMode = False
    SH.UsedRange.Delete
    
    '*********************
    'Query for Data Import
    '*********************
    sSql = ""
    sSql = "EXEC " & tDatabase & ".DIT.DL_CreateStageTables  '" & EntityName & "', '" & trDatabase & "', 0"
    
    '**************************************************************************************
    'Add a Query into the QueryTable, This will allow the sheet to get the data from the DB
    '**************************************************************************************
     Set oQT = SH.QueryTables.Add(Connection:=sConn, Destination:=SH.Range("A1"), Sql:=sSql)
     
    '************************************************************
    'Refresh The Worksheet so that it get the information from DB
    '************************************************************
    oQT.FieldNames = True
    oQT.RefreshStyle = xlOverwriteCells
    oQT.AdjustColumnWidth = True
    oQT.Refresh False
    oQT.Delete
    
    SH.Range("1:1").AutoFilter
    
    
    '**************************
    'Turn on the display alerts
    '**************************
    Application.DisplayAlerts = True
    
    '***********************************************************************
    'Turn on the screen updating and auto calculation (performance upgrade?)
    '***********************************************************************
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    

    
    

End Sub

Public Sub ExecuteWorksheet()


Dim sht As Worksheet
Dim LastRow As Long
Dim DataRange As Range
Dim rng As Range, cell As Range

Worksheets("tmpEntities").Activate

Set sht = ActiveSheet


'Using SpecialCells Function
LastRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row

Set DataRange = Range("A2" & ":" & "A" & LastRow)


If LastRow <> 1 Then

For Each cell In DataRange

If CheckIfSheetExists(cell.Value) = False Then

ImportEntities.DeleteSheet (cell.Value)
CreateWorkSheets.GetSqlDataForWorksheets (cell.Value)
Worksheets(cell.Value).Cells.EntireColumn.AutoFit
ImportEntities.HidingUnusedColumns (cell.Value)

If CreateWorkSheets.CheckToDeleteWorksheet(cell.Value) = True Then
    ImportEntities.DeleteSheet (cell.Value)
End If


End If

Next cell

End If


ImportEntities.DeleteSheet ("tmpEntities")


End Sub

Public Sub SaveWorkbook()

ActiveWorkbook.Save

End Sub

Public Sub GetSqlDataTmpEntities(ProcName As String)

    
    Dim tServer As String
    Dim tWorkstation As String
    Dim tDatabase As String
    Dim trDatabase As String
    Dim tDataset As String
    Dim SH As Worksheet
    Dim WHSH As Worksheet
    Dim wsht As Worksheet
    Dim QT As QueryTable
    Dim oQT As QueryTable
    Dim sConn As String
    Dim sSql As String
    

    '************************************************************************
    'Turn off the screen updating and auto calculation (performance upgrade?)
    '************************************************************************
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    
    '**************************************************************************
    'Turn off the Display Alerts. This allows overwrite of old Data Excel Files
    '**************************************************************************
    Application.DisplayAlerts = False
    
    tServer = ConnectionSetup.Range("B1").Value
    tWorkstation = ConnectionSetup.Range("B2").Value
    tDatabase = ConnectionSetup.Range("B3").Value
    trDatabase = ConnectionSetup.Range("B4").Value
    tDataset = ConnectionSetup.Range("B5").Value
    
    
    
    '************************************************
    'Write the Connection Information into a variable
    '************************************************
    sConn = "OLEDB;Provider=SQLOLEDB.1;"
    sConn = sConn & "Trusted_Connection=Yes;"
    sConn = sConn & "Initial Catalog=" & tDatabase & ";"
    sConn = sConn & "Data Source=" & tServer & ";"
    sConn = sConn & "Workstation ID=" & tWorkstation & ";"
            
    For Each wsht In Worksheets
        If wsht.Name = "tmpEntities" Then
            Set SH = wsht
        End If
    Next
    
    For Each wsht In Worksheets
        If wsht.Name = "WorksheetList" Then
            Set WHSH = wsht
        End If
    Next
    
    If WHSH Is Nothing Then
        If SH Is Nothing Then
           Set SH = Sheets.Add(After:=Worksheets("ConnectionSetup"))
           SH.Name = "tmpEntities"
        End If
    
    Else
     
    If SH Is Nothing Then
        Set SH = Sheets.Add(After:=Worksheets("WorksheetList"))
        SH.Name = "tmpEntities"
     End If
     
     End If
   
    '**************************************************
    'Clear out all of the query tables in the worksheet
    '**************************************************
    For Each QT In SH.QueryTables
        QT.Delete
    Next QT
    
    SH.AutoFilterMode = False
    SH.UsedRange.Delete
    
    '*********************
    'Query for Data Import
    '*********************
    sSql = ""
    sSql = "EXEC " & tDatabase & ".DIT." & ProcName
    
    '**************************************************************************************
    'Add a Query into the QueryTable, This will allow the sheet to get the data from the DB
    '**************************************************************************************
     Set oQT = SH.QueryTables.Add(Connection:=sConn, Destination:=SH.Range("A1"), Sql:=sSql)
     
    '************************************************************
    'Refresh The Worksheet so that it get the information from DB
    '************************************************************
    oQT.FieldNames = True
    oQT.RefreshStyle = xlOverwriteCells
    oQT.AdjustColumnWidth = True
    oQT.Refresh False
    oQT.Delete
    
    SH.Range("1:1").AutoFilter
    
    
    '**************************
    'Turn on the display alerts
    '**************************
    Application.DisplayAlerts = True
    
    '***********************************************************************
    'Turn on the screen updating and auto calculation (performance upgrade?)
    '***********************************************************************
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True

End Sub

Function CheckToDeleteWorksheet(SheetName As String) As Boolean
      
      CheckToDeleteWorksheet = False
      
      
        Dim WS As Worksheet
        Dim SH As Worksheet
        Dim CheckValue As String

    For Each WS In Worksheets
        If WS.Name = SheetName Then
            Set SH = WS
        End If
    Next
    
    CheckValue = SH.Range("A1")
      
    If CheckValue = "DELETEWORKSHEET" Then
      CheckToDeleteWorksheet = True
    End If
    
   End Function
   
   
    
Public Sub CreateWorksheetsForTables(EntityName As String)

    
    Dim tServer As String
    Dim tWorkstation As String
    Dim tDatabase As String
    Dim trDatabase As String
    Dim tDataset As String
    Dim SH As Worksheet
    Dim wsht As Worksheet
    Dim QT As QueryTable
    Dim oQT As QueryTable
    Dim sConn As String
    Dim sSql As String
    'Dim EntityName As String

    '************************************************************************
    'Turn off the screen updating and auto calculation (performance upgrade?)
    '************************************************************************
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    
    '**************************************************************************
    'Turn off the Display Alerts. This allows overwrite of old Data Excel Files
    '**************************************************************************
    Application.DisplayAlerts = False
    
    tServer = ConnectionSetup.Range("B1").Value
    tWorkstation = ConnectionSetup.Range("B2").Value
    tDatabase = ConnectionSetup.Range("B3").Value
    trDatabase = ConnectionSetup.Range("B4").Value
    tDataset = ConnectionSetup.Range("B5").Value
    'EntityName = "Equipment"
    
    
    '************************************************
    'Write the Connection Information into a variable
    '************************************************
    sConn = "OLEDB;Provider=SQLOLEDB.1;"
    sConn = sConn & "Trusted_Connection=Yes;"
    sConn = sConn & "Initial Catalog=" & tDatabase & ";"
    sConn = sConn & "Data Source=" & tServer & ";"
    sConn = sConn & "Workstation ID=" & tWorkstation & ";"
            
    For Each wsht In Worksheets
        If wsht.Name = EntityName Then
            Set SH = wsht
        End If
    Next
   
    If SH Is Nothing Then
        Set SH = Sheets.Add(After:=Worksheets("tmpEntities"))
        SH.Name = EntityName
     End If
   
    '**************************************************
    'Clear out all of the query tables in the worksheet
    '**************************************************
    For Each QT In SH.QueryTables
        QT.Delete
    Next QT
    
    SH.AutoFilterMode = False
    SH.UsedRange.Delete
    
    '*********************
    'Query for Data Import
    '*********************
    sSql = ""
    sSql = "EXEC " & tDatabase & ".DIT.DL_SelectTable  '" & EntityName & "'"
    
    '**************************************************************************************
    'Add a Query into the QueryTable, This will allow the sheet to get the data from the DB
    '**************************************************************************************
     Set oQT = SH.QueryTables.Add(Connection:=sConn, Destination:=SH.Range("A1"), Sql:=sSql)
     
    '************************************************************
    'Refresh The Worksheet so that it get the information from DB
    '************************************************************
    oQT.FieldNames = True
    oQT.RefreshStyle = xlOverwriteCells
    oQT.AdjustColumnWidth = True
    oQT.Refresh False
    oQT.Delete
    
    SH.Range("1:1").AutoFilter
    
    
    '**************************
    'Turn on the display alerts
    '**************************
    Application.DisplayAlerts = True
    
    '***********************************************************************
    'Turn on the screen updating and auto calculation (performance upgrade?)
    '***********************************************************************
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    
    ResetWKB.DeleteDNMXLRow
    

    
    

End Sub

Public Sub ExecuteImportSQLWorksheet()


Dim sht As Worksheet
Dim LastRow As Long
Dim DataRange As Range
Dim rng As Range, cell As Range

Worksheets("tmpEntities").Activate

Set sht = ActiveSheet


'Using SpecialCells Function
LastRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row

Set DataRange = Range("A2" & ":" & "A" & LastRow)


If LastRow <> 1 Then

For Each cell In DataRange


CreateWorkSheets.CreateWorksheetsForTables (cell.Value)
Worksheets(cell.Value).Cells.EntireColumn.AutoFit
ImportEntities.HidingUnusedColumns (cell.Value)

Next cell

End If


ImportEntities.DeleteSheet ("tmpEntities")


End Sub

Public Sub PlaceActivePath()


Worksheets("ConnectionSetup").Activate
'MsgBox ActiveWorkbook.Path
Range("b6").Value = ActiveWorkbook.Path


End Sub





Attribute VB_Name = "DataSaveAsCSV"
Sub SaveAsCSV(CSVWORKSHEET As String, CSVPATH As String)
'
' SaveAsCSV Macro
' Save as a CSV if it is already a csv
'

'
    ' Dimension all variables.
    Dim DestFile As String
    Dim FileNum As Integer
    Dim ColumnCount As Integer
    Dim RowCount As Integer
    Dim myPath As String
    Dim myExtension As String
    Dim aWorksheet As Worksheet
    Dim sel As Range
    Dim fst As Object


    
    
    
    myPath = ActiveWorkbook.FullName

    
    
    
    DestFile = CSVPATH & Application.PathSeparator & CSVWORKSHEET & ".csv"
    myExtension = Right(myPath, Len(myPath) - InStrRev(myPath, "."))
    If myExtension = "xlsm" Then
    
    
       Set fst = CreateObject("ADODB.Stream")
       fst.Type = 2
       fst.Charset = "utf-8"
       fst.Open
       
    
       ' Obtain next free file handle number.
       'FileNum = FreeFile()
    
       ' Turn error checking off.
       On Error Resume Next
    
       ' Attempt to open destination file for output.
      ' Open DestFile For Output As #FileNum
    
       ' If an error occurs report it and end.
       If Err <> 0 Then
          MsgBox "Cannot open filename " & DestFile
          End
       End If
    
       ' Turn error checking on.
       On Error GoTo 0
       Set aWorksheet = ThisWorkbook.Worksheets(CSVWORKSHEET)
       Set sel = aWorksheet.UsedRange
       
       ' Loop for each row in selection.
       For RowCount = 1 To sel.Rows.Count
    
          ' Loop for each column in selection.
          For ColumnCount = 1 To sel.Columns.Count
    
             ' Write current cell's text to file with quotation marks.
                ''Print #FileNum, """" & Replace(aWorksheet.Cells(RowCount, ColumnCount).Text, Chr(34), Chr(34) & Chr(34)) & """";
                fst.writetext """" & Replace(aWorksheet.Cells(RowCount, ColumnCount).Text, Chr(34), Chr(34) & Chr(34)) & """"
             ' Check if cell is in last column.
             If ColumnCount = sel.Columns.Count Then
                ' If so, then write a blank line.
                ''Print #FileNum,
                fst.writetext vbNewLine
             Else
                ' Otherwise, write a comma.
                ''Print #FileNum, ",";
                fst.writetext ","
             End If
          ' Start next iteration of ColumnCount loop.
          Next ColumnCount
       ' Start next iteration of RowCount loop.
       Next RowCount
    
       ' Close destination file.
       ''Close #FileNum
       fst.SaveToFile DestFile, 2
       
    'ActiveWorkbook.Close SaveChanges:=False
    'FileCopy DestFile, myPath
    'Workbooks.Open myPath
    'Kill DestFile
    
       
    End If
    
    

End Sub




Attribute VB_Name = "ImportEntities"



Public Sub GetSqlDataForEntities()

    
    Dim tServer As String
    Dim tWorkstation As String
    Dim tDatabase As String
    Dim trDatabase As String
    Dim tDataset As String
    Dim SH As Worksheet
    Dim wsht As Worksheet
    Dim QT As QueryTable
    Dim oQT As QueryTable
    Dim sConn As String
    Dim sSql As String

    '************************************************************************
    'Turn off the screen updating and auto calculation (performance upgrade?)
    '************************************************************************
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    
    '**************************************************************************
    'Turn off the Display Alerts. This allows overwrite of old Data Excel Files
    '**************************************************************************
    Application.DisplayAlerts = False
    
    tServer = ConnectionSetup.Range("B1").Value
    tWorkstation = ConnectionSetup.Range("B2").Value
    tDatabase = ConnectionSetup.Range("B3").Value
    trDatabase = ConnectionSetup.Range("B4").Value
    tDataset = ConnectionSetup.Range("B5").Value
    tPackage = ConnectionSetup.Range("B7").Value
    
    '************************************************
    'Write the Connection Information into a variable
    '************************************************
    sConn = "OLEDB;Provider=SQLOLEDB.1;"
    sConn = sConn & "Trusted_Connection=Yes;"
    sConn = sConn & "Initial Catalog=" & tDatabase & ";"
    sConn = sConn & "Data Source=" & tServer & ";"
    sConn = sConn & "Workstation ID=" & tWorkstation & ";"
            
    For Each wsht In Worksheets
        If wsht.Name = "WorksheetList" Then
            Set SH = wsht
        End If
    Next
   
    If SH Is Nothing Then
        Set SH = Sheets.Add(After:=Worksheets("ConnectionSetup"))
        SH.Name = "WorksheetList"
     End If
   
    '**************************************************
    'Clear out all of the query tables in the worksheet
    '**************************************************
    For Each QT In SH.QueryTables
        QT.Delete
    Next QT
    
    SH.AutoFilterMode = False
    SH.UsedRange.Delete
    
    '*********************
    'Query for Data Import
    '*********************
    sSql = ""
    sSql = "EXEC " & tDatabase & ".DIT.DL_GetEntityList  '" & trDatabase & "', '" & tPackage & "'"
    
    '**************************************************************************************
    'Add a Query into the QueryTable, This will allow the sheet to get the data from the DB
    '**************************************************************************************
     Set oQT = SH.QueryTables.Add(Connection:=sConn, Destination:=SH.Range("A1"), Sql:=sSql)
     
    '************************************************************
    'Refresh The Worksheet so that it get the information from DB
    '************************************************************
    oQT.FieldNames = True
    oQT.RefreshStyle = xlOverwriteCells
    oQT.AdjustColumnWidth = True
    oQT.Refresh False
    oQT.Delete
    
    SH.Range("1:1").AutoFilter
    
    
    '**************************
    'Turn on the display alerts
    '**************************
    Application.DisplayAlerts = True
    
    '***********************************************************************
    'Turn on the screen updating and auto calculation (performance upgrade?)
    '***********************************************************************
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True

End Sub
Sub AddYesNo(Worksheetname As String)

    Worksheets(Worksheetname).Activate
    Columns("A:A").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Yes,No"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub


Sub HidingRowCleanup(SheetName As String)

Dim sht As Worksheet
Dim LastRow As Long
Dim DataRange As Range

Worksheets(SheetName).Activate

Set sht = ActiveSheet


'Using SpecialCells Function
LastRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row

Set DataRange = Range("A" & LastRow + 1)
    Range(DataRange, Selection.End(xlDown)).Select
    Selection.EntireRow.Hidden = True

End Sub

Sub DeleteSheet(SheetName As String)

For Each Sheet In ActiveWorkbook.Worksheets
    If Sheet.Name = SheetName Then
        Sheets(Sheet.Name).Visible = xlSheetVisible
        Application.DisplayAlerts = False
        Worksheets(SheetName).Delete
        Application.DisplayAlerts = True
    End If
Next Sheet
End Sub

Sub HidingUnusedColumns(SheetName As String)


Dim sht As Worksheet
Dim LastColumn As Long
Dim DataRange As Range


Worksheets(SheetName).Activate

Set sht = ActiveSheet

LastColumn = sht.Range("A1").CurrentRegion.Columns.Count + 1

 Columns(LastColumn).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.EntireColumn.Hidden = True


End Sub


Public Sub GetSqlDataForWorkFlows()

    
    Dim tServer As String
    Dim tWorkstation As String
    Dim tDatabase As String
    Dim trDatabase As String
    Dim tDataset As String
    Dim SH As Worksheet
    Dim wsht As Worksheet
    Dim QT As QueryTable
    Dim oQT As QueryTable
    Dim sConn As String
    Dim sSql As String

    '************************************************************************
    'Turn off the screen updating and auto calculation (performance upgrade?)
    '************************************************************************
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    
    '**************************************************************************
    'Turn off the Display Alerts. This allows overwrite of old Data Excel Files
    '**************************************************************************
    Application.DisplayAlerts = False
    
    tServer = ConnectionSetup.Range("B1").Value
    tWorkstation = ConnectionSetup.Range("B2").Value
    tDatabase = ConnectionSetup.Range("B3").Value
    trDatabase = ConnectionSetup.Range("B4").Value
    tDataset = ConnectionSetup.Range("B5").Value
    
    '************************************************
    'Write the Connection Information into a variable
    '************************************************
    sConn = "OLEDB;Provider=SQLOLEDB.1;"
    sConn = sConn & "Trusted_Connection=Yes;"
    sConn = sConn & "Initial Catalog=" & tDatabase & ";"
    sConn = sConn & "Data Source=" & tServer & ";"
    sConn = sConn & "Workstation ID=" & tWorkstation & ";"
            
    For Each wsht In Worksheets
        If wsht.Name = "WorkFlowList" Then
            Set SH = wsht
        End If
    Next
   
    If SH Is Nothing Then
        Set SH = Sheets.Add(After:=Worksheets("WorksheetList"))
        SH.Name = "WorkFlowList"
     End If
   
    '**************************************************
    'Clear out all of the query tables in the worksheet
    '**************************************************
    For Each QT In SH.QueryTables
        QT.Delete
    Next QT
    
    SH.AutoFilterMode = False
    SH.UsedRange.Delete
    
    '*********************
    'Query for Data Import
    '*********************
    sSql = ""
    sSql = "EXEC " & tDatabase & ".DIT.DL_FillWorkFlowData  '" & trDatabase & "', 1"
    
    '**************************************************************************************
    'Add a Query into the QueryTable, This will allow the sheet to get the data from the DB
    '**************************************************************************************
     Set oQT = SH.QueryTables.Add(Connection:=sConn, Destination:=SH.Range("A1"), Sql:=sSql)
     
    '************************************************************
    'Refresh The Worksheet so that it get the information from DB
    '************************************************************
    oQT.FieldNames = True
    oQT.RefreshStyle = xlOverwriteCells
    oQT.AdjustColumnWidth = True
    oQT.Refresh False
    oQT.Delete
    
    SH.Range("1:1").AutoFilter
    
    
    '**************************
    'Turn on the display alerts
    '**************************
    Application.DisplayAlerts = True
    
    '***********************************************************************
    'Turn on the screen updating and auto calculation (performance upgrade?)
    '***********************************************************************
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True

End Sub
Public Sub CreateTransferSheet()

    
    Dim tServer As String
    Dim tWorkstation As String
    Dim tDatabase As String
    Dim trDatabase As String
    Dim tDataset As String
    Dim SH As Worksheet
    Dim wsht As Worksheet
    Dim QT As QueryTable
    Dim oQT As QueryTable
    Dim sConn As String
    Dim sSql As String

    '************************************************************************
    'Turn off the screen updating and auto calculation (performance upgrade?)
    '************************************************************************
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    
    '**************************************************************************
    'Turn off the Display Alerts. This allows overwrite of old Data Excel Files
    '**************************************************************************
    Application.DisplayAlerts = False
    
    tServer = ConnectionSetup.Range("B1").Value
    tWorkstation = ConnectionSetup.Range("B2").Value
    tDatabase = ConnectionSetup.Range("B3").Value
    trDatabase = ConnectionSetup.Range("B4").Value
    tDataset = ConnectionSetup.Range("B5").Value
    
    '************************************************
    'Write the Connection Information into a variable
    '************************************************
    sConn = "OLEDB;Provider=SQLOLEDB.1;"
    sConn = sConn & "Trusted_Connection=Yes;"
    sConn = sConn & "Initial Catalog=" & tDatabase & ";"
    sConn = sConn & "Data Source=" & tServer & ";"
    sConn = sConn & "Workstation ID=" & tWorkstation & ";"
            
    For Each wsht In Worksheets
        If wsht.Name = "transferparameter" Then
            Set SH = wsht
        End If
    Next
   
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 192000 bytes
SHA-256: 63058b996d5667ce2571599e92017d8d1838e940b8d2a3fcbbb9cb5af8a69f3b

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