DB2: Execute reorg from JDBC based tool

When using DataGrip, DbVisualizer, SQuirreL or any other JDBC based tool:

CALL SYSPROC.ADMIN_CMD ('REORG TABLE TABLE_NAME')

It should work also with other db2 client native commands.

Comments

[reachasd]

Option Explicit

'==========================================================
' Build one section per MVG BC Name (Column C) from Excel.
' - Groups are made by contiguous identical values in Col C
' - Sheet1 is sorted by Column C first to guarantee blocks
' - Summary table: 4 rows × 2 cols
' - Field-list table: 5 cols (Field Group | Nbr. | Field | Universe | LOV)
' - Nbr. & LOV columns are fixed to ~1.0 cm
'==========================================================

Public Sub BuildTablesFromExcel()
Dim xlApp As Object, xlWB As Object, xlWS As Object
Dim fd As FileDialog, filePath As String
Dim data As Variant
Dim nRows As Long, nCols As Long
Dim i As Long, j As Long, startRow As Long, endRow As Long
Dim grpKey As String
Dim madeFirstGroup As Boolean
Dim groupCount As Long

Const COL_A As Long = 1            ' Class Name
Const COL_B As Long = 2            ' Group Class Name (Field Group Name)
Const COL_C As Long = 3            ' MVG Business Component Name (group key)
Const COL_D As Long = 4            ' Search Specification
Const COL_E As Long = 5            ' Class Field Name
Const COL_F As Long = 6            ' List Applet Name

On Error GoTo CleanFail
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'--- Pick Excel file
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Title = "Select the Excel file (Sheet1)"
    .Filters.Clear
    .Filters.Add "Excel files", "*.xlsx; *.xlsm; *.xlsb; *.xls"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo CleanExit
    filePath = .SelectedItems(1)
End With

'--- Open Excel (late binding)
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlWB = xlApp.Workbooks.Open(filePath, False, True)   ' read-only
Set xlWS = xlWB.Worksheets(1)                            ' Sheet1

'--- Ensure contiguous groups by sorting on Column C
With xlWS.Sort
    .SortFields.Clear
    .SortFields.Add Key:=xlWS.Range("C1"), SortOn:=0, Order:=1, DataOption:=0
    .SetRange xlWS.UsedRange
    .Header = 1
    .MatchCase = False
    .Orientation = 1
    .Apply
End With

'--- Pull used range to memory
If xlWS.UsedRange.Rows.Count < 2 Then
    MsgBox "No data rows (headers expected in row 1, data from row 2).", vbExclamation
    GoTo CleanExit
End If
data = xlWS.UsedRange.Value
nRows = UBound(data, 1): nCols = UBound(data, 2)

'--- Walk contiguous blocks of Column C
i = 2 ' start after headers
Do While i <= nRows
    grpKey = KeyOf(data(i, COL_C))
    If Len(grpKey) = 0 Then
        i = i + 1
        GoTo NextRow
    End If

    startRow = i
    Dim className As String, listApplet As String, searchSpec As String
    className = "": listApplet = "": searchSpec = ""

    j = i
    Do While j <= nRows And KeyOf(data(j, COL_C)) = grpKey
        If Len(className) = 0 Then className = TrimSafe(data(j, COL_B))
        If Len(listApplet) = 0 And Len(TrimSafe(data(j, COL_F))) > 0 Then listApplet = TrimSafe(data(j, COL_F))
        If Len(searchSpec) = 0 And Len(TrimSafe(data(j, COL_D))) > 0 Then searchSpec = TrimSafe(data(j, COL_D))
        j = j + 1
    Loop
    endRow = j - 1

    ' New page after the first section
    If madeFirstGroup Then
        Selection.EndKey wdStory
        Selection.InsertBreak wdPageBreak
    Else
        madeFirstGroup = True
    End If

    ' Heading shows the pretty/original value
    AddHeading "MVG BC Name: " & TrimSafe(data(i, COL_C))

    ' Summary block (4×2)
    AddSummaryTable className, listApplet, TrimSafe(data(i, COL_C)), searchSpec

    ' Field-list table (5 columns)
    AddFieldListTable data, startRow, endRow, COL_B, COL_E

    groupCount = groupCount + 1
    i = endRow + 1

NextRow:
Loop

MsgBox "Done. Sections created: " & groupCount, vbInformation

CleanExit:
On Error Resume Next
If Not xlWB Is Nothing Then xlWB.Close SaveChanges:=False
If Not xlApp Is Nothing Then xlApp.Quit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub

CleanFail:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation
Resume CleanExit
End Sub

'-------------------- Helpers --------------------

Private Function TrimSafe(ByVal v As Variant) As String
If IsError(v) Or IsNull(v) Then
TrimSafe = ""
Else
TrimSafe = Trim$(CStr(v))
End If
End Function

' Normalizes a key for group comparison (case/space safe)
Private Function KeyOf(ByVal v As Variant) As String
Dim s As String
s = TrimSafe(v)
s = Replace(s, ChrW(160), " ") ' NBSP -> space
s = Application.Clean(s) ' remove control chars
s = Trim$(Replace$(s, vbTab, " "))
Do While InStr(s, " ") > 0
s = Replace$(s, " ", " ")
Loop
KeyOf = UCase$(s) ' case-insensitive
End Function

Private Sub AddHeading(ByVal text As String)
Dim r As Range
Set r = ActiveDocument.Range(ActiveDocument.Content.End - 1, ActiveDocument.Content.End - 1)
r.InsertAfter text & vbCr
r.Style = wdStyleHeading2
r.InsertParagraphAfter
End Sub

Private Sub AddSummaryTable(ByVal className As String, _
ByVal listApplet As String, _
ByVal mvgBCName As String, _
ByVal searchSpec As String)

Dim tbl As Table, r As Range, rIx As Long
Set r = ActiveDocument.Range(ActiveDocument.Content.End - 1, ActiveDocument.Content.End - 1)
Set tbl = ActiveDocument.Tables.Add(r, 4, 2)

With tbl
    .AllowAutoFit = False
    .AutoFitBehavior wdAutoFitFixed
    .Rows.AllowBreakAcrossPages = False
    .Borders.Enable = True
    .Range.ParagraphFormat.SpaceAfter = 6

    .Cell(1, 1).Range.Text = "Class Name:"
    .Cell(1, 2).Range.Text = className
    .Cell(2, 1).Range.Text = "List Applet Name:"
    .Cell(2, 2).Range.Text = listApplet
    .Cell(3, 1).Range.Text = "MVG BC Name:"
    .Cell(3, 2).Range.Text = mvgBCName
    .Cell(4, 1).Range.Text = "Search Specification:"
    .Cell(4, 2).Range.Text = searchSpec

    For rIx = 1 To .Rows.Count
        .Cell(rIx, 1).Range.Bold = True
    Next rIx
End With

' spacing after
tbl.Range.Collapse wdCollapseEnd
tbl.Range.InsertParagraphAfter

End Sub

Private Sub AddFieldListTable(ByRef data As Variant, _
ByVal startRow As Long, _
ByVal endRow As Long, _
ByVal colClassName As Long, _
ByVal colFieldNames As Long)

Dim rowsCount As Long: rowsCount = endRow - startRow + 1
If rowsCount <= 0 Then Exit Sub

Dim tbl As Table, r As Range
Dim i As Long, outRow As Long, fieldName As String

Set r = ActiveDocument.Range(ActiveDocument.Content.End - 1, ActiveDocument.Content.End - 1)
Set tbl = ActiveDocument.Tables.Add(r, rowsCount + 1, 5)

With tbl
    .AllowAutoFit = False
    .AutoFitBehavior wdAutoFitFixed
    .Rows.AllowBreakAcrossPages = False
    .Borders.Enable = True

    ' --- header ---
    .Cell(1, 1).Range.Text = "Field Group Names"
    .Cell(1, 2).Range.Text = "Nbr."
    .Cell(1, 3).Range.Text = "Field Names"
    .Cell(1, 4).Range.Text = "Universe Object Name"
    .Cell(1, 5).Range.Text = "LOV"
    .Rows(1).Range.Bold = True

    ' --- merge first column down the group ---
    If rowsCount > 1 Then .Cell(2, 1).Merge .Cell(rowsCount + 1, 1)
    .Cell(2, 1).Range.Text = TrimSafe(data(startRow, colClassName))
    .Cell(2, 1).Range.Bold = True
    .Cell(2, 1).VerticalAlignment = wdCellAlignVerticalCenter

    ' --- fill rows ---
    For i = 0 To rowsCount - 1
        outRow = i + 2
        .Cell(outRow, 2).Range.Text = CStr(i + 1)                             ' Nbr.
        fieldName = TrimSafe(data(startRow + i, colFieldNames))
        .Cell(outRow, 3).Range.Text = fieldName                               ' Field
        .Cell(outRow, 4).Range.Text = fieldName                               ' Universe (same)
        .Cell(outRow, 5).Range.Text = ""                                       ' LOV (blank)
    Next i

    ' --- pin widths AFTER merges/fill ---
    .Columns(2).SetWidth CentimetersToPoints(1), wdAdjustNone                  ' Nbr. ~1 cm
    .Columns(.Columns.Count).SetWidth CentimetersToPoints(1), wdAdjustNone     ' LOV  ~1 cm
    .Columns(3).PreferredWidthType = wdPreferredWidthPercent                   ' optional balance
    .Columns(3).PreferredWidth = 60
    .Columns(4).PreferredWidthType = wdPreferredWidthPercent
    .Columns(4).PreferredWidth = 30
End With

' spacing after table
tbl.Range.Collapse wdCollapseEnd
tbl.Range.InsertParagraphAfter

End Sub