Malicious Office (OOXML) — 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

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
   
…