Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 01813daa53abaa8b…

MALICIOUS

Office (OOXML)

1.68 MB Created: 2018-04-20 15:53:13 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2018-07-27
MD5: 28c35117953af1434b8325ca22efb82c SHA-1: 5ee060b768fb34f9d1db3fe750a763bab01ad049 SHA-256: 01813daa53abaa8ba5063d6ccc2638062aeeac895a10a42be59e5ecd46f37499
526 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File T1059.003 Windows Command Shell T1105 Ingress Tool Transfer

The sample is an Excel macro-enabled document that contains a Workbook_Open macro. This macro is designed to show a user form and then execute a command to launch a publisher file located at 'h:\publisher\check_to_print_with_check_image.pub'. The presence of advance-fee scam lures in the heuristics suggests this is likely part of a phishing or social engineering attack to trick the user into opening a malicious publisher file.

Heuristics 15

  • ClamAV: Doc.Dropper.Agent-6570766-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Dropper.Agent-6570766-0
  • VBA project inside OOXML medium 8 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
        Dim x As Variant
    x = Shell(strApp, vbNormalFocus)
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        Dim wsh As Object
    Set wsh = VBA.CreateObject("Wscript.shell")
  • PowerShell reference in VBA critical OLE_VBA_PS
    PowerShell reference in VBA
    Matched line in script
        Dim resp As Variant
    resp = MsgBox("Invoking Powershell to read current worksheet " & ws & " as table and export as both CSV and JSON", vbOKCancel, "Export sheet")
  • LOLBin reference in VBA critical OLE_VBA_LOLBIN
    LOLBin reference in VBA
    Matched line in script
        If r = 5 Then 'if access denied, try this alternative
            r = ShellExecute(0, "open", "rundll32.exe", "url.dll,FileProtocolHandler " & strUrl, 0, 1)
    End If
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Dim wsh As Object
    Set wsh = VBA.CreateObject("Wscript.shell")
  • cmd.exe reference in VBA high OLE_VBA_CMD
    cmd.exe reference in VBA
    Matched line in script
        arg = "cmd.exe /s /c subst.exe h: " & x
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    'PLACE IN ThisWorkbook SHEET MODULE
Private Sub Workbook_Open()
    Application.ScreenUpdating = False
  • Advance-fee lottery/parcel scam lure high SE_ADVANCE_FEE_SCAM_LURE
    Document contains lottery/beneficiary or prize language together with large-value draft/funds wording and parcel/courier delivery requirements. This is a classic advance-fee fraud document shape.
  • Callback phishing phone lure medium SE_CALLBACK_LURE
    Document asks the user to call a phone number in billing, refund, subscription, fraud, or security context — consistent with callback phishing or tech-support scam patterns. Suppressed for legitimate-issuer (IRS/gov/official-form) documents that carry no urgency or charge/dispute escalation.
  • External hyperlinks (4) low OOXML_EXTERNAL_HYPERLINKS
    Document contains 4 external hyperlinks — clickable URLs are stored as external relationships. First target: Help/Assess.html
  • Fake invoice / payment lure low SE_INVOICE_LURE
    Document contains invoice or payment language paired with an action verb — useful context when combined with link, macro, or attachment indicators
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://www.taltech.com/support/entry/opening_and_closing_an_application_from_vba Document hyperlink
    • https://wellsr.com/vba/2016/excel/create-awesome-excel-splash-screen-for-your-spreadsheet/Document hyperlink
    • https://wellsr.com/vba/Document hyperlink
    • http://www.excelfunctions.net/vba-curdir-function.htmlDocument hyperlink
    • http://www.excel-easy.com/examples/reject-invalid-dates.htmlDocument hyperlink
    • https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tablesDocument hyperlink
    • https://www.exceltrick.com/formulas_macros/filesystemobject-in-vba/Document hyperlink
    • https://www.askvg.com/create-a-virtual-drive-for-your-desired-folder-in-my-computer-using-subst-command/Document hyperlink
    • http://learnexcelmacro.com/wp/2017/09/save-excel-range-data-as-csv-file-through-excel-vba/#VBA-to-save-excel-table-to-csvDocument hyperlink
    • https://www.pryor.com/blog/ease-the-pain-of-data-entry-with-an-excel-forms-template/Document hyperlink
    • https://www.exceldemy.com/vlookup-index-and-match-and-dget/Document hyperlink
    • http://www.contextures.com/xlUserForm01.htmlDocument hyperlink
    • https://www.exceldemy.com/using-excel-worksheet-functions-in-vba/Document hyperlink
    • http://learnexcelmacro.com/wp/2014/06/read-write-document-properties-excel-macro/Document hyperlink
    • https://www.techonthenet.com/excel/formulas/rnd.phpDocument hyperlink
    • http://www.lawofwar.org/geneva_prisoner_war_convention.htmDocument hyperlink
    • https://excelmacromastery.com/excel-vba-collections/Document hyperlink
    • https://excelmacromastery.com/vba-dictionary/#A_Quick_Guide_to_the_VBA_DictionaryDocument hyperlink
    • https://chandoo.org/wp/2011/12/01/case-in-sensitive-string-compare-vba/Document hyperlink
    • https://www.thespreadsheetguru.com/the-code-vault/vba-code-add-spreadsheet-hyperlink-to-picture-objectDocument hyperlink
    • http://lawofwar.org/geneva_prisoner_war_convention.htmDocument hyperlink
    • http://www.bluepecantraining.com/portfolio/excel-vba-how-to-add-rows-and-columns-to-excel-table-with-vba-macro/Document hyperlink
    • https://www.boening.us/Document hyperlink
    • https://www.adriann.us/Document hyperlink
    • http://schemas.micrDocument hyperlink
    • http://schemas.mDocument hyperlink
    • http://schemasDocument hyperlink
    • http://schemas.microsoftDocument hyperlink
    • http://schemas.miDocument hyperlink
    • https://excelmacromastery.com/vba-dictionary/Document hyperlink
    • http://tbd.com/Document hyperlink
    • http://www.af.mil/News/Article-Display/Article/601830/cac-change-aids-visually-color-impaired-security-officers/Document hyperlink
    • https://stackoverflow.com/questions/31347919/how-to-export-vbaproject-in-excelDocument hyperlink
    • http://www.fontspace.com/digital-graphics-labs/micr-encodingDocument hyperlink
    • http://www.fontspace.com/juan-casco/hangul-love2Document hyperlink
    • https://stackoverflow.com/questions/17956651/execute-a-command-in-command-prompt-using-excel-vbaDocument hyperlink
    • https://support.office.com/en-us/article/create-or-delete-an-excel-table-e81aa349-b006-4f8a-9806-5af9df0ac664?ui=en-US&rs=en-US&ad=USDocument hyperlink
    • https://support.office.com/en-us/article/create-custom-functions-in-excel-2f06c10b-3622-40d6-a1b2-b6748ae8231fDocument hyperlink
    • https://support.microsoft.com/en-us/help/291073/how-to-use-the-forms-controls-on-a-worksheet-in-excelDocument hyperlink
    • https://download.microsoft.com/download/9/b/4/9b49c8c5-d7a9-45b1-b8b6-52067e9970a8/AF101984660_en-us_xl_qrc_vlookup%20refresher.pdfDocument hyperlink
    • https://support.microsoft.com/en-us/help/213360/how-to-convert-a-numeric-value-into-english-words-in-excelDocument hyperlink
    • https://www.mrexcel.com/excel-tips/replacing-vlookup-using-the-data-model-and-relationships/Document hyperlink
    • https://stackoverflow.com/questions/326476/how-to-round-a-number-in-vba-to-the-nearest-5-or-10-or-xDocument hyperlink
    • https://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-existsDocument hyperlink
    • http://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-existsDocument hyperlink
    • https://stackoverflow.com/questions/18811431/refer-to-excel-cell-in-table-by-header-name-and-row-number-vbaDocument hyperlink
    • https://appsource.microsoft.com/en-us/product/office/WA104051163Document hyperlink
    • http://ns.adobe.com/xap/1.0/Document hyperlink
    • http://www.w3.org/1999/02/22-rdf-syntax-ns#Document hyperlink
    • http://ns.adobe.com/xap/1.0/mm/Document hyperlink
    +8 more URL(s)

Extracted artifacts 4

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 38562 bytes
SHA-256: a12b4ab82c4bb4b5cc2244aae5ba8ffb08b8378ef1d905122df8006fe784b823
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

'PLACE IN ThisWorkbook SHEET MODULE
Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    ActiveWindow.Visible = False
    SplashUserForm.Show
    Windows(ThisWorkbook.name).Visible = True
    Application.ScreenUpdating = True
    
    SetSubst
    Worksheets("Main").Activate
End Sub

Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Control = "CommandButton1, 15, 0, MSForms, CommandButton"
Attribute VB_Control = "CommandButton2, 16, 1, MSForms, CommandButton"
Private Sub CommandButton1_Click()

    ControlPanel.Show

End Sub

Private Sub CommandButton2_Click()

    'Print checks form check_to_print_with_check_image.pub
    
    Dim fileName As String
    
    fileName = "h:\publisher\check_to_print_with_check_image.pub"
    
    Launch_Publisher_v2 fileName
    
    
End Sub

Attribute VB_Name = "Sheet14"
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 = "Sheet3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Main"
Option Explicit

#If VBA7 Then
   Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
    ' Do nothing
#End If

Sub LaunchURL(strUrl As String)

On Error GoTo ErrorHandler
    Dim r As Long
    r = ShellExecute(0, "open", strUrl, 0, 0, 1)
    If r = 5 Then 'if access denied, try this alternative
            r = ShellExecute(0, "open", "rundll32.exe", "url.dll,FileProtocolHandler " & strUrl, 0, 1)
    End If
    Exit Sub
    
ErrorHandler:
    MsgBox "Error encountered while trying to launch URL." & vbNewLine & vbNewLine & "Error: " & Err.Number & ", " & Err.Description, vbCritical, "Error Encountered"
    Resume Next
    
End Sub

Public Function GetWorkBookPath()

Const thisfunc As String = "GetWorkBookPath"
    
On Error GoTo ErrorHandler
        
    GetWorkBookPath = ThisWorkbook.path
    
Exit Function


ErrorHandler:
    MsgBox "Error encountered while trying to run " & thisfunc & vbNewLine & vbNewLine & "Error: " & Err.Number & ", " & Err.Description, vbCritical, "Error Encountered"
    Resume Next
    
End Function

Sub LaunchApp(appPath As String)
    
    'Status: WIP
    'Purpose: Launch App
    'Parameter: path to local executable
    'Author: Luke Boening
    'Create date: 2018-05-02
    'Last update: 2018-05-02
    'Unit Test: TBD
    
    
On Error GoTo ErrorHandler

    Dim strApp As String
    strApp = appPath
    
    Dim x As Variant
    x = Shell(strApp, vbNormalFocus)

ExitHere:
    Exit Sub

ErrorHandler:
    MsgBox "Error in function: " & Err.Description
    Resume Next

End Sub


'Requires Microsoft Visual Basic for Applications Extensibility
Public Function ExportVBA(path As String)
  
  Dim objVbComp As VBComponent
Dim strPath As String
Dim varItem As Variant
Dim fso As New FileSystemObject
Dim fileName As String

On Error GoTo ErrorHandler

fileName = fso.GetFileName(path)

On Error Resume Next
    MkDir ("h:\exportvba\" & fileName & "\")
On Error GoTo 0

'Change the path to suit the users needs
strPath = "d:\code\diamondsaber\export\" & fileName & "\"

  For Each varItem In ActiveWorkbook.VBProject.VBComponents
  Set objVbComp = varItem

  Select Case objVbComp.Type
     Case vbext_ct_StdModule
        objVbComp.Export strPath & "\" & objVbComp.name & ".bas"
     Case vbext_ct_Document, vbext_ct_ClassModule
        ' ThisDocument and class modules
        objVbComp.Export strPath & "\" & objVbComp.name & ".cls"
     Case vbext_ct_MSForm
        objVbComp.Export strPath & "\" & objVbComp.name & ".frm"
     Case Else
        objVbComp.Export strPath & "\" & objVbComp.name
  End Select
Next varItem

ExitHere:
    Exit Function

ErrorHandler:
    MsgBox "Error in function: " & Err.Description
    Resume ExitHere

End Function

Sub SetSubst()

Const thisfunc = "SetSubst"

' Function name: SetSubst
' Purpose: Sets drive letter to specified folder
' Parameter: None
' Last update: 2018-05-02
' Revision: 0.2.1

On Error GoTo ErrorHandler

    Dim wsh As Object
    Set wsh = VBA.CreateObject("Wscript.shell")

    Dim x As String
    x = GetWorkBookPath

    Dim waitOnReturn As Boolean: waitOnReturn = True
    
    Dim windowStyle As Integer: windowStyle = 1
    
    Dim arg As String
    
    arg = "cmd.exe /s /c subst.exe h: " & x
    
    MsgBox arg, vbInformation, "About to set H: drive letter with these arguments"
    
    wsh.Run arg, windowStyle, waitOnReturn

    MsgBox "Success: drive letter h:", vbOKOnly, "Success or Failure"
    

ExitHere:
    Exit Sub
    
ErrorHandler:
    MsgBox "Error in function " & thisfunc & vbCrLf & Err.Description
    Resume ExitHere
    
End Sub



Sub LoopThroughTable()

Const thisfunc = "LoopThroughTable"

On Error GoTo ErrorHandler

    'STATUS: wip
    
    'SubName: LoopThroughTable
    'Parameter: none
    'Purpose: Loop through all tables and do something
    'Reference: https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
    'Revision: 0.1.4
    'Last update: 2018-05-02

     Dim tbl As ListObject
     
     Dim sht As Worksheet
     
     Dim alternativeComment As String
     alternativeComment = ""
     
     For Each sht In ThisWorkbook.Worksheets
     
        For Each tbl In sht.ListObjects
        
            'Do something here
            
            ' tbl.AlternativeText = alternativeComment
            
            Debug.Print tbl.name
            
        Next tbl
     Next sht

Exit Sub

ErrorHandler:
    MsgBox "there was an error" & Err.Description
    Resume Next

End Sub

Sub GetTableData()

    'Status: experimental

    MsgBox Sheets("Config").Range("C17")
    
    Dim myrange As Range
    
    Set myrange = Worksheets("Config").Range("a2:c17")
    

End Sub



Public Function DisplaySheetName() As String
    'Status: PRODUCTION
    
    DisplaySheetName = ActiveSheet.name
    
End Function

Public Function GetBook() As String
    'Status: PRODUCTION
    
    GetBook = ActiveWorkbook.name
End Function

Public Function GetFullName() As String
    'Status: PRODUCTION
    
    GetFullName = ActiveWorkbook.FullName
End Function


Sub GetHelp()
    'Status: WIP
    
    Dim currentSheet As String
    
    currentSheet = ActiveSheet.name
    
    MsgBox "Activating help for sheet " & currentSheet
    
    Dim thispath As String
    
    thispath = ThisWorkbook.path
    
    
    LaunchURL thispath & "/help/" & currentSheet & ".html"
    
       
End Sub

Public Function GETRANDCHECKAMT() As Integer
  'STATUS: WIP
  'Purpose: Return a random check amount
  'Record content author: Luke Boening
  'Create date: 2018-05-03
  'Last update: 2018-05-03
  'Revision: 0.1.3
  'Parameter: none
  '
   
   Dim LRandomNumber As Integer

   Dim upperbound As Integer
   Dim lowerbound As Integer
   
   upperbound = 1000
   lowerbound = 10
   
   Randomize
   LRandomNumber = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

   GETRANDCHECKAMT = Round(LRandomNumber / 5) * 5
End Function



Sub ExportSheet()

Const psScript As String = "Export-SheetName.ps1"
Const workbookname As String = "DiamondSaber_2018.xlsm"
Const driveletter As String = "H:"

On Error GoTo ErrorHandler

    Dim ws As String
    ws = DisplaySheetName

    Dim msg As String
    Dim resp As Variant
    resp = MsgBox("Invoking Powershell to read current worksheet " & ws & " as table and export as both CSV and JSON", vbOKCancel, "Export sheet")

    Debug.Print resp
    
    If resp = 2 Then
        MsgBox "Exiting sub"
        Exit Sub
    End If
    
        
       
    Dim arg As String
    Dim arg2 As String
    Dim arg1 As String
    Dim arg3 As String
    arg = driveletter & "\Powershell\" & psScript
    arg1 = driveletter & "\" & workbookname
    arg2 = ws
    arg3 = driveletter & "\export"
    
    Dim path As String
    ' Set the Path variable equal to the path of your program's installation
    path = "PowerShell" & " -file " & arg & " " & arg1 & " " & arg2 & " " & arg3

    Dim x As Variant
    x = Shell(path, vbNormalFocus)
    
Exit Sub
    
ErrorHandler:
  MsgBox "Error encountered while trying to export sheet." & vbNewLine & vbNewLine & "Error: " & Err.Number & ", " & Err.Description, vbCritical, "Error Encountered"
  Resume Next

End Sub

Sub ShowThisDataForm()
'
' ShowThisDataForm Macro
' Data form

    ActiveSheet.ShowDataForm
End Sub

Sub LaunchPub(pubPath As String)
    'Launch Microsoft Publisher
    'Parameter: pubFileName
    'Description: Launch Microsoft Publisher with command line argument to file
    Const thisfunc = "LaunchPub"

On Error GoTo ErrorHandler
    
    Dim x As Variant
    Dim path As String
    
    Dim arg As String
    arg = pubPath
    
    ' Set the Path variable equal to the path of your program's installation
    path = "MSPUB.EXE" & " /t " & arg

    x = Shell(path, vbNormalFocus)

Exit Sub
    
ErrorHandler:
    MsgBox "There was an error in " & thisfunc & ":" & Err.Description
    Resume Next
    
End Sub

Public Function ListAllDocumentProperties()

On Error Resume Next

Dim prop As Variant


'below loop will traverse for all items of this collection of properties
For Each prop In ThisWorkbook.BuiltinDocumentProperties
    Debug.Print prop.name 'Property Name like "Author" etc
    ' Debug.Print prop.Value 'Property value like Author name updated in proprty
Next
End Function

Public Function GetCheckDate() As Long

Const thisfunc As String = "GetCheckDate"


On Error GoTo ErrorHandler

   Dim LRandomNumber As Long

   Dim upperbound As Long
   Dim lowerbound As Long
   
   upperbound = 43333
   lowerbound = 43323
   
   Randomize
   LRandomNumber = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

   GetCheckDate = LRandomNumber



Exit Function

ErrorHandler:
    MsgBox "There was an error " & Err.Description
    Resume Next
    

End Function

Public Function GetCheckDateAsString() As String

Const thisfunc = "GetCheckDateAsString"

On Error GoTo ErrorHandler

Dim checkdate As Long
checkdate = GetCheckDate

Dim strCheckDate As String

strCheckDate = Format(checkdate, "mmmm d, yyyy")

GetCheckDateAsString = strCheckDate
Exit Function


ErrorHandler:
    MsgBox "There was an error " & Err.Description
    Resume Next

End Function

Sub LaunchPowershell(powershellScript As String)

Const workbookname As String = "DiamondSaber_2018.xlsm"
Const driveletter As String = "H:"

On Error GoTo ErrorHandler

Dim vscript As String
Select Case powershellScript
    Case "Get-Directory.ps1"
        vscript = "Get-Directory.ps1"
        
    Case Else
        MsgBox "Script not found. Aborting LaunchPowershell"
        Exit Sub
End Select

    Dim ws As String
    ws = DisplaySheetName

    Dim msg As String
    Dim resp As Variant
    resp = MsgBox("Invoking Powershell script: " & vscript, vbOKCancel, "Export sheet")

    Debug.Print resp
    
    If resp = 2 Then
        MsgBox "Exiting sub"
        Exit Sub
    End If
    
        
       
    Dim arg As String
    Dim arg2 As String
    Dim arg1 As String
    Dim arg3 As String
    arg = driveletter & "\Powershell\" & vscript
    'arg1 = driveletter & "\" & workbookname
    'arg2 = ws
    'arg3 = driveletter & "\export"
    
    Dim path As String
    ' Set the Path variable equal to the path of your program's installation
    
    ' path = "PowerShell" & " -file " & arg & " " & arg1 & " " & arg2 & " " & arg3

    path = "PowerShell" & " -file " & arg

    Dim x As Variant
    x = Shell(path, vbNormalFocus)
    
Exit Sub
    
ErrorHandler:
  MsgBox "Error encountered while trying to run powershell." & vbNewLine & vbNewLine & "Error: " & Err.Number & ", " & Err.Description, vbCritical, "Error Encountered"
  Resume Next


End Sub

Sub DeleteUnknownSheet()
'
' DeleteUnknownSheet Macro
' Delete unknown sheet by name
'

'
    Sheets("Sheet4").Select
    ActiveWindow.SelectedSheets.Delete
End Sub


Sub HideSheets()

    Dim found, myobject, mycollection(2) As String
    
    found = False
    
    mycollection(0) = "Config"
    
    For Each myobject In mycollection
      Debug.Print myobject
      ActiveWorkbook.Sheets("Config").Visible = xlSheetHidden
    Next
    
End Sub

Sub ExposeSheets()

    Dim found, myobject, mycollection(2) As String
    
    found = False
    
    mycollection(0) = "Config"
    
    For Each myobject In mycollection
        Debug.Print myobject
        ActiveWorkbook.Sheets("Config").Visible = True
    Next
    
End Sub
Sub RefreshDataSheet()
'
' RefreshDataSheet Macro
' Refresh current sheet
'

'
    Range("directory[[#Headers],[Name]]").Select
    Selection.ListObject.TableObject.Refresh
End Sub

Sub GetProgramPath()
        
    Dim path As String
    path = GetWorkBookPath
    
    MsgBox "WorkBook path is " & path, vbInformation
    

End Sub

Sub Launch_Publisher()
    Dim path As String
    path = "h:\publisher\check_to_print.pub"
    
    Dim result As Variant
    
    result = MsgBox("About to print " & path, vbOKCancel)
    
    If result = 2 Then
        MsgBox "Exiting Sub"
        Exit Sub
    End If
    
    LaunchPub path
    
End Sub

Sub Launch_Publisher_v2(fileName As String)
    Dim path As String
    
    path = fileName
    Dim result As Variant
    result = MsgBox("About to print " & path, vbOKCancel)
    
    If result = 2 Then
        MsgBox "Cancelling launch_publisher_v2"
        Exit Sub
    End If
    
    LaunchPub path
    
End Sub

Sub Launch_URL()

    Dim file As String
    
    file = "file:///h:/README.html"
    
    LaunchURL file

End Sub

Sub Launch_Powershell()
    Const thisfunc = "Launch_Powershell"
    
On Error GoTo ErrorHandler
    LaunchPowershell "Get-Directory.ps1"
    
    RefreshDataSheet

Exit Sub

ErrorHandler:
    MsgBox "There was an error " & Err.Description
    Resume Next
    
End Sub


Public Sub AddRowToTable(wrkSheet As String, tblName As String, dataCol1 As String, dataCol2 As String)
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("tLog")
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add
With newrow
    .Range(2) = "AddRowToTable"
    .Range(3) = "AddRowToTable"
    .Range(4) = "2018-05-13T11:29:00"
End With

End Sub

Public Function SetDataToTextFile(tblName As String)

'STATUS: Broke

Const thisfunc = "SetDataToTextFile"

Dim myFile As String, tbl As ListObject, cellValue As Variant, i As Integer, j As Integer

Dim rng As Range

myFile = Application.DefaultFilePath & "\data\tGetSheetNameExists.csv"


Set tbl = ActiveSheet.ListObjects("tGetSheetNameExists")

Dim x As Long
Dim r As Long


For x = 1 To tbl.Range.Rows.Count - 1

    For r = 1 To tbl.Range.Columns.Count
        
      Debug.Print tbl.ListColumns(x).Range.Cells(1).Value
    
    Next r
    
Next x


End Function

Public Function getrandchecknumber() As Integer
Const thisfunc = "GetRandCheckNumber"

On Error GoTo ErrorHandler

   Dim LRandomNumber As Integer

   Dim upperbound As Integer
   Dim lowerbound As Integer
   
   upperbound = 5000
   lowerbound = 100
   
   Randomize
   getrandchecknumber = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

Exit Function

ErrorHandler:
    MsgBox "There was an error in " & thisfunc
    Resume Next

End Function


Sub SetTableToCSV(shtName As String, tblName As String)

Const thisfunc = "SetTableToCSV"

'Reference: http://learnexcelmacro.com/wp/2017/09/save-excel-range-data-as-csv-file-through-excel-vba/#VBA-to-save-excel-table-to-csv

On Error GoTo ErrorHandler

    Dim tbl As ListObject
    Dim csvFilePath As String
    Dim fNum As Integer
    Dim tblArr
    Dim rowArr
    Dim csvVal
    Dim hdrArr


    Set tbl = Worksheets(shtName).ListObjects(tblName)
    
    If tbl Is Nothing Then
        MsgBox "Subroutine SetTableToCSV could not find that sheet and table name combination. Exiting Sub"
        Exit Sub
    End If
    
    
    csvFilePath = ThisWorkbook.path & "\export\" & tblName & ".csv"
    
    tblArr = tbl.DataBodyRange.Value
    
    hdrArr = tbl.HeaderRowRange.Value
    
    Dim i As Long
    Dim j As Long
    Dim mycell As String
    Dim finalRow As String
    

    fNum = FreeFile()
    Open csvFilePath For Output As #fNum
    
    'Export header
    For i = 1 To UBound(hdrArr)
        rowArr = Application.Index(hdrArr, i, 0)
            
         finalRow = ""
         
         For j = 1 To UBound(rowArr)
            mycell = """"
            mycell = mycell & rowArr(j)
            If j = UBound(rowArr) Then
                mycell = mycell & """"
            Else
                mycell = mycell & """;"
            End If
            
            ' Debug.Print mycell
            ' Debug.Print j
            finalRow = finalRow & mycell
         Next
         
        Print #1, finalRow
    Next
    
    Debug.Print finalRow

    For i = 1 To UBound(tblArr)
        rowArr = Application.Index(tblArr, i, 0)
            
         finalRow = ""
         
         For j = 1 To UBound(rowArr)
            mycell = """"
            mycell = mycell & Replace(rowArr(j), Chr(34), Chr(39))
            
            If j = UBound(rowArr) Then
                mycell = mycell & """"
            Else
                mycell = mycell & """;"
            End If
            
            ' Debug.Print mycell
            ' Debug.Print j
            finalRow = finalRow & mycell
         Next
         
        Print #1, finalRow
    Next
    
    Debug.Print finalRow




    Close #fNum
    
    Set hdrArr = Nothing
    Set tblArr = Nothing
    Set rowArr = Nothing
    Set csvVal = Nothing
    
    MsgBox "Export complete"
    
Exit Sub

ErrorHandler:

    Select Case Err.Number
    Case 9
        MsgBox "I couldn't find that sheet name and table combination. Exiting"
        Exit Sub
        
    Case Else
        MsgBox "Error in exporting this table " & Err.Description
        Exit Sub
End Select
    
    MsgBox "There was an error in " & thisfunc & ". " & Err.Description & ". " & Err.Number
    Resume Next
    

End Sub

Attribute VB_Name = "Sheet4"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet20"
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 = "TestModule1"
Option Explicit
Option Private Module

'@TestModule
'@Folder("Tests")

Private Assert As Object
Private Fakes As Object

'@ModuleInitialize
Public Sub ModuleInitialize()
    'this method runs once per module.
    Set Assert = CreateObject("Rubberduck.AssertClass")
    Set Fakes = CreateObject("Rubberduck.FakesProvider")
End Sub

'@ModuleCleanup
Public Sub ModuleCleanup()
    'this method runs once per module.
    Set Assert = Nothing
    Set Fakes = Nothing
End Sub

'@TestInitialize
Public Sub TestInitialize()
    'this method runs before every test in the module.
End Sub

'@TestCleanup
Public Sub TestCleanup()
    'this method runs after every test in the module.
End Sub

'@TestMethod
Public Sub TestMethod1() 'TODO Rename test
    On Error GoTo TestFail
    
    'Arrange:

    'Act:

    'Assert:
    Assert.Inconclusive

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod
Public Sub TestMethod2() 'TODO Rename test
    On Error GoTo TestFail
    
    'Arrange:

    'Act:

    'Assert:
    Assert.Inconclusive

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub



Attribute VB_Name = "Sheet6"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet7"
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 = "Sheet8"
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 = "SplashUserForm"
Attribute VB_Base = "0{A47CE5C9-7A93-42A8-8A8E-749E899ED3DD}{BE84332C-4D95-442B-A25C-A46C4CE1E080}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 549376 bytes
SHA-256: d4d6bf5a58922abd151fd183df0a6880f7f69ea620b6228e8ccd739061260cdd
emf_00.emf ooxml-emf OOXML EMF part: xl/media/image2.emf 2780 bytes
SHA-256: 5138dd55ee13e44e8030e6037201ed077c790d617217d1f02cd4837cbcb31bc4
emf_01.emf ooxml-emf OOXML EMF part: xl/media/image1.emf 2784 bytes
SHA-256: aa236bc61f02f7cb95ff62b5c2f1a2902efe179281df36f38ffe5e04ca2e67c8

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