Excel (VBA) is not dead !

erol34 · Feb 24, 2023

I invite Basic lovers to read the last post on my blog.. Please feel free to share your thoughts. You can easily translate page to your language by using the translate widget on the left..

EnriqueGonzalez · Feb 24, 2023

Yet...
Microsoft released a couple of years ago an excel whose macros are written in typescript.

erol34 · Feb 24, 2023

EnriqueGonzalez said:
Yet...
Microsoft released a couple of years ago an excel whose macros are written in typescript.

As far as I know, yes it is true for cloud version of Microsoft 365.. But there is still VBA support for desktop version.

Johan Schoeman · Feb 24, 2023

I use Excel VBA often - mostly to extract data from Syspro and display it in a spread sheet.

erol34 · Feb 24, 2023

Johan Schoeman said:
I use Excel VBA often - mostly to extract data from Syspro and display it in a spread sheet.

Then, do you use VBA to get data from SQL Server ?

aeric · Feb 24, 2023

erol34 said:
As far as I know, yes it is true for cloud version of Microsoft 365.. But there is still VBA support for desktop version.

Good to know

Office Scripts vs VBA - Microsoft's take on VBA in 2022 - Analyst Cave

What is Microsoft's take on Office Scripts vs VBA in 2022. Will Office Scripts replace Visual Basic for Applications Macros?

analystcave.com

and BASIC is still love by many people https://gotbasic.com/ (B4X is listed here too)

Johan Schoeman · Feb 24, 2023

erol34 said:
Then, do you use VBA to get data from SQL Server ?

Yes, from MSSQL server

Johan Schoeman · Feb 25, 2023

erol34 said:
Then, do you use VBA to get data from SQL Server ?

VBA code to extract complete BOM of a SKU from Syspro MSSQL database (the server is hosted in the cloud):

B4X:

Private Sub CommandButton1_Click()

    For i = 6 To 35
        For j = 1 To 9
            Sheet6.Cells(i, j) = ""
        Next j
    Next i


    Dim cn
    Dim rst, rst1, rst2, rst3, rst4
    Dim lpRM
    Dim lp
   
    Application.ScreenUpdating = False
    Set cn = CreateObject("adodb.connection")
    With cn
    .provider = "sqloledb"
    .connectionstring = "server=xxx-xxx-xxx;uid=sa;Trusted_connection=yes"
    .Open
    .defaultdatabase = "Syspro_Live_xxx_x"
    End With
   
    Set rst = CreateObject("adodb.recordset")
    With rst
    .activeconnection = cn
    .Source = "SELECT BomStructure.ParentPart, BomStructure.Component, BomStructure.QtyPer, BomStructure.Route, BomStructure.ScrapPercentage, BomStructure.CreateSubJob FROM BomStructure WHERE ParentPart = '" & Sheet6.Cells(1, 2) & "' AND BomStructure.Route='0'"
    .Open
    End With
   
    teller = 6
    Dim stockcode As String
    Dim parentpart As String
    Dim component As String
    Dim qtyper As Double
    stockcode = ""
    qtyper = 0
    component = ""
   
    Dim parentcount As Integer
    parentcount = 0
    While Not rst.EOF
        If parentcount = 0 Then
            parentcount = 1
            Sheet6.Cells(teller, 1) = rst("ParentPart")
           
            Sheet6.Cells(teller, 7) = 1
            teller = teller + 1
        End If
       
        stockcode = rst("ParentPart")
       
        Sheet6.Cells(teller, 2) = rst("Component")
        Sheet6.Cells(teller, 7) = rst("QtyPer")
       
        teller = teller + 1
       
        qtyper = rst("QtyPer")
        component = rst("Component")
       
        If component <> "" Then
            Set rst1 = CreateObject("adodb.recordset")
            With rst1
            .activeconnection = cn
            .Source = "SELECT BomStructure.ParentPart, BomStructure.Component, BomStructure.QtyPer, BomStructure.Route, BomStructure.ScrapPercentage, BomStructure.CreateSubJob from BomStructure WHERE ParentPart = '" & component & "' AND BomStructure.Route='0'"
            .Open
            End With
           
            While Not rst1.EOF
                Sheet6.Cells(teller, 3) = rst1("Component")
                component1 = rst1("Component")
                Sheet6.Cells(teller, 7) = rst1("QtyPer")
                teller = teller + 1
               
                If component1 <> "" Then
                    Set rst2 = CreateObject("adodb.recordset")
                    With rst2
                    .activeconnection = cn
                    .Source = "SELECT BomStructure.ParentPart, BomStructure.Component, BomStructure.QtyPer, BomStructure.Route, BomStructure.ScrapPercentage, BomStructure.CreateSubJob from BomStructure WHERE ParentPart = '" & component1 & "' AND BomStructure.Route='0'"
                    .Open
                    End With
                   
                    While Not rst2.EOF
                        Sheet6.Cells(teller, 4) = rst2("Component")
                        component2 = rst2("Component")
                        Sheet6.Cells(teller, 7) = rst2("QtyPer")
                        teller = teller + 1
                       
                        If component2 <> "" Then
                            Set rst3 = CreateObject("adodb.recordset")
                            With rst3
                            .activeconnection = cn
                            .Source = "SELECT BomStructure.ParentPart, BomStructure.Component, BomStructure.QtyPer, BomStructure.Route, BomStructure.ScrapPercentage, BomStructure.CreateSubJob from BomStructure WHERE ParentPart = '" & component2 & "' AND BomStructure.Route='0'"
                            .Open
                            End With
                           
                            While Not rst3.EOF
                                Sheet6.Cells(teller, 5) = rst3("Component")
                                component3 = rst3("Component")
                                Sheet6.Cells(teller, 7) = rst3("QtyPer")
                                teller = teller + 1
                               
                                If component3 <> "" Then
                                    Set rst4 = CreateObject("adodb.recordset")
                                    With rst4
                                    .activeconnection = cn
                                    .Source = "SELECT BomStructure.ParentPart, BomStructure.Component, BomStructure.QtyPer, BomStructure.Route, BomStructure.ScrapPercentage, BomStructure.CreateSubJob from BomStructure WHERE ParentPart = '" & component3 & "' AND BomStructure.Route='0'"
                                    .Open
                                    End With
                                   
                                    While Not rst4.EOF
                                        Sheet6.Cells(teller, 6) = rst4("Component")
                                        component3 = rst3("Component")
                                        Sheet6.Cells(teller, 7) = rst4("QtyPer")
                                        teller = teller + 1
                                        rst4.MoveNext
                                    Wend
                                   
                                    Set rst4 = Nothing
                                End If
                               
                                rst3.MoveNext
                            Wend
                           
                            Set rst3 = Nothing
                        End If
                       
                        rst2.MoveNext
                    Wend
                   
                    Set rst2 = Nothing
                End If
               
                rst1.MoveNext
            Wend
           
            Set rst1 = Nothing
        End If
       
        rst.MoveNext
   
    Wend

    Set rst = Nothing
   
   
    Set cn = CreateObject("adodb.connection")
    With cn
    .provider = "sqloledb"
    .connectionstring = "server=xxx-xxx-xxx;uid=sa;Trusted_connection=yes"
    .Open
    .defaultdatabase = "Syspro_Live_xxx_x"
    End With
   
    Set rst = CreateObject("adodb.recordset")
    With rst
    .activeconnection = cn
    .Source = "SELECT * FROM vwAdmFormData WHERE StockCode = '" & Sheet6.Cells(1, 2) & "'"
    .Open
    End With
   
   
    While Not rst.EOF
   
        Sheet6.Cells(6, 12) = Trim(rst("ExtWth"))
        Sheet6.Cells(8, 12) = Trim(rst("ExtThk"))
        Sheet6.Cells(9, 12) = Trim(rst("Densi"))
        Sheet6.Cells(10, 12) = Trim(rst("ExtTre"))
        Sheet6.Cells(11, 12) = Trim(rst("ExNrol"))
        Sheet6.Cells(12, 12) = Trim(rst("mRoll"))
        Sheet6.Cells(13, 12) = Trim(rst("ExCol"))
        Sheet6.Cells(14, 12) = Trim(rst("ExtWup"))
        Sheet6.Cells(15, 12) = Trim(rst("ExtJoi"))
        Sheet6.Cells(16, 12) = Trim(rst("ExtEdg"))
        Sheet6.Cells(17, 12) = Trim(rst("ExtCor"))
        Sheet6.Cells(18, 12) = Trim(rst("Dyelev"))
        Sheet6.Cells(19, 12) = Trim(rst("Cylind"))
        Sheet6.Cells(20, 12) = Trim(rst("PrtWup"))
        Sheet6.Cells(21, 12) = Trim(rst("Acros"))
        Sheet6.Cells(22, 12) = Trim(rst("Aroun"))
        Sheet6.Cells(23, 12) = Trim(rst("PrtPos"))
        Sheet6.Cells(24, 12) = Trim(rst("InkTyp"))
        Sheet6.Cells(25, 12) = Trim(rst("Logo"))
        Sheet6.Cells(26, 12) = Trim(rst("EyeMar"))
        Sheet6.Cells(27, 12) = Trim(rst("Printt"))
        Sheet6.Cells(28, 12) = Trim(rst("Col1"))
        Sheet6.Cells(29, 12) = Trim(rst("Col2"))
        Sheet6.Cells(30, 12) = Trim(rst("Col3"))
        Sheet6.Cells(31, 12) = Trim(rst("Col4"))
        Sheet6.Cells(32, 12) = Trim(rst("Col5"))
        Sheet6.Cells(33, 12) = Trim(rst("Col6"))
        Sheet6.Cells(34, 12) = Trim(rst("BagWth"))
        Sheet6.Cells(35, 12) = Trim(rst("LefGus"))
        Sheet6.Cells(36, 12) = Trim(rst("RigGus"))
        Sheet6.Cells(37, 12) = Trim(rst("BagLen"))
        Sheet6.Cells(38, 12) = Trim(rst("TopGus"))
        Sheet6.Cells(39, 12) = Trim(rst("BotGus"))
        Sheet6.Cells(40, 12) = Trim(rst("LatSea"))
        Sheet6.Cells(41, 12) = Trim(rst("Lip"))
        Sheet6.Cells(42, 12) = Trim(rst("Seal"))
        Sheet6.Cells(43, 12) = Trim(rst("Pack"))
        Sheet6.Cells(44, 12) = Trim(rst("Punpos"))
        Sheet6.Cells(45, 12) = Trim(rst("BagBal"))
        Sheet6.Cells(46, 12) = Trim(rst("Wrap"))
        Sheet6.Cells(47, 12) = Trim(rst("Miperf"))
        Sheet6.Cells(48, 12) = Trim(rst("BalTot"))
        Sheet6.Cells(49, 12) = Trim(rst("SliRol"))
        Sheet6.Cells(50, 12) = Trim(rst("SliTot"))
        Sheet6.Cells(51, 12) = Trim(rst("Inst1"))
        Sheet6.Cells(52, 12) = Trim(rst("Ins2"))
        Sheet6.Cells(53, 12) = Trim(rst("Ins3"))
        Sheet6.Cells(54, 12) = Trim(rst("Ins4"))
        Sheet6.Cells(55, 12) = Trim(rst("Ins5"))
        Sheet6.Cells(56, 12) = Trim(rst("Ins6"))
        Sheet6.Cells(57, 12) = Trim(rst("Ins7"))
        Sheet6.Cells(58, 12) = Trim(rst("Ins8"))
        Sheet6.Cells(59, 12) = Trim(rst("Ins9"))
        Sheet6.Cells(60, 12) = Trim(rst("Ins10"))
        Sheet6.Cells(61, 12) = Trim(rst("LabelType"))
        Sheet6.Cells(62, 12) = Trim(rst("SealLayer"))
        Sheet6.Cells(63, 12) = Trim(rst("VBlock"))
        Sheet6.Cells(64, 12) = Trim(rst("VType"))
        Sheet6.Cells(65, 12) = Trim(rst("Pitch"))
        Sheet6.Cells(66, 12) = Trim(rst("PrintSR"))
        Sheet6.Cells(67, 12) = Trim(rst("PrintPlate"))
       
        rst.MoveNext
    Wend
   
    Set rst = Nothing

End Sub

It yields this:

Johan Schoeman · Feb 25, 2023

...and doing more or less the same with B4J for the same SKU/ Stock Code

B4X:

'Static code module
Sub Process_Globals
    Private fx As JFX
    Private frm As Form
    Private xui As XUI
    Dim SQL1 As SQL
   
'    Private TextField1 As TextField
'    Private TextField2 As TextField

    Private B4XTable1 As B4XTable
    Private Button1, Button2 As Button
    Private Label1, Label2 As Label
    Private NameColumn(20) As B4XTableColumn
    Dim cvs As B4XCanvas

    Private ProgressBar1 As ProgressBar
    Private ComboBox1 As ComboBox
    Private ComboBox2 As ComboBox
    Public salesyear As String
    Public salesmonth As String
   
    Private CheckBox1 As CheckBox
   

    Private TextField1 As TextField
   
    Private ImageView2 As ImageView
End Sub

Public Sub Show
'    If frm.IsInitialized = False Then
    frm.Initialize("frm", 400, 400)
    frm.WindowWidth = fx.PrimaryScreen.MaxX - fx.PrimaryScreen.MinX           'set the screen to full width/height
    frm.WindowLeft = fx.PrimaryScreen.MinX
    frm.WindowHeight = fx.PrimaryScreen.MaxY - fx.PrimaryScreen.MinY
    frm.WindowTop = fx.PrimaryScreen.MinY
   
    frm.RootPane.LoadLayout("explodedBOM")
'    End If
    frm.Show
   
    ImageView2.Visible = False
    Label2.Visible = False
   
    Button1.MouseCursor = fx.Cursors.HAND
    Button2.MouseCursor = fx.Cursors.HAND
    TextField1.MouseCursor = fx.Cursors.HAND
    Label2.MouseCursor = fx.Cursors.HAND
   
    Label1.Text = "BO = R0.00"
    TextField1.Text = Main.mystockcode
   
'    ComboBox1.Items.AddAll(Array As String("2015", "2016", "2017", "2018", "2019", "2020", "2021", "2022", "2023", "2024", "2025", "2026", "2027", "2028", "2029", "2030"))
'    ComboBox2.Items.AddAll(Array As String("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"))
'
'    Dim currentyear As Int = DateTime.GetYear(DateTime.Now)
'    Dim currentmonth As Int = DateTime.GetMonth(DateTime.Now)
'  
'    If currentyear = 2015 Then ComboBox1.SelectedIndex = 0
'    If currentyear = 2016 Then ComboBox1.SelectedIndex = 1
'    If currentyear = 2017 Then ComboBox1.SelectedIndex = 2
'    If currentyear = 2018 Then ComboBox1.SelectedIndex = 3
'    If currentyear = 2019 Then ComboBox1.SelectedIndex = 4
'    If currentyear = 2020 Then ComboBox1.SelectedIndex = 5
'    If currentyear = 2021 Then ComboBox1.SelectedIndex = 6
'    If currentyear = 2022 Then ComboBox1.SelectedIndex = 7
'    If currentyear = 2023 Then ComboBox1.SelectedIndex = 8
'    If currentyear = 2024 Then ComboBox1.SelectedIndex = 9
'    If currentyear = 2025 Then ComboBox1.SelectedIndex = 10
'    If currentyear = 2026 Then ComboBox1.SelectedIndex = 11
'    If currentyear = 2027 Then ComboBox1.SelectedIndex = 12
'    If currentyear = 2028 Then ComboBox1.SelectedIndex = 13
'    If currentyear = 2029 Then ComboBox1.SelectedIndex = 14
'
'    If currentmonth = 1 Then ComboBox2.SelectedIndex = 0
'    If currentmonth = 2 Then ComboBox2.SelectedIndex = 1
'    If currentmonth = 3 Then ComboBox2.SelectedIndex = 2
'    If currentmonth = 4 Then ComboBox2.SelectedIndex = 3
'    If currentmonth = 5 Then ComboBox2.SelectedIndex = 4
'    If currentmonth = 6 Then ComboBox2.SelectedIndex = 5
'    If currentmonth = 7 Then ComboBox2.SelectedIndex = 6
'    If currentmonth = 8 Then ComboBox2.SelectedIndex = 7
'    If currentmonth = 9 Then ComboBox2.SelectedIndex = 8
'    If currentmonth = 10 Then ComboBox2.SelectedIndex = 9
'    If currentmonth = 11 Then ComboBox2.SelectedIndex = 10
'    If currentmonth = 12 Then ComboBox2.SelectedIndex = 11
   
    ProgressBar1.Visible = False
   
    B4XTable1.MaximumRowsPerPage=20
    B4XTable1.BuildLayoutsCache(B4XTable1.MaximumRowsPerPage)
    B4XTable1.RowHeight = 30dip

   
    NameColumn(0) = B4XTable1.AddColumn("StockCode", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(1) = B4XTable1.AddColumn("StockUom", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(2) = B4XTable1.AddColumn("Description", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(3) = B4XTable1.AddColumn("LongDesc", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(4) = B4XTable1.AddColumn("Ebq", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(5) = B4XTable1.AddColumn("QtyPer", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(6) = B4XTable1.AddColumn("PartCategory", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(7) = B4XTable1.AddColumn("MaterialCost", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(8) = B4XTable1.AddColumn("WorkCentre", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(9) = B4XTable1.AddColumn("ISetUpTime", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(10) = B4XTable1.AddColumn("IQuantity", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(11) = B4XTable1.AddColumn("WorkCentreDesc", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(12) = B4XTable1.AddColumn("CreateSubJob", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(13) = B4XTable1.AddColumn("ScrapPct", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(14) = B4XTable1.AddColumn("LabourCost", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(15) = B4XTable1.AddColumn("FixOverhead", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(16) = B4XTable1.AddColumn("VariableOverhead", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(17) = B4XTable1.AddColumn("ParentTotal", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(18) = B4XTable1.AddColumn("IRunTime", B4XTable1.COLUMN_TYPE_TEXT)
    NameColumn(19) = B4XTable1.AddColumn("SubContractCost", B4XTable1.COLUMN_TYPE_TEXT)
   


'    NameColumn(17) = B4XTable1.AddColumn("GM %", B4XTable1.COLUMN_TYPE_TEXT)
'    NameColumn(18) = B4XTable1.AddColumn("R/kg", B4XTable1.COLUMN_TYPE_TEXT)
   
    B4XTable1.LabelsFont = xui.CreateDefaultFont(10.0)                       'set the text size of the cells in the B4XTable
    B4XTable1.TextColor = xui.Color_Black                                    'set the text color in the table
    B4XTable1.OddRowColor = xui.Color_LightGray                              'set the highlight color of the odd rows
   

   
   
    Dim p As B4XView = xui.CreatePanel("")
    p.SetLayoutAnimated(0, 0, 0, 1dip, 1dip)
    cvs.Initialize(p)
   
    For Each c As B4XTableColumn In B4XTable1.VisibleColumns
        Dim pnl As B4XView = c.CellsLayouts.Get(0) '+1 because of the header
        pnl.GetView(0).Color = xui.Color_Blue
        pnl.GetView(0).TextColor = xui.Color_White
        pnl.GetView(0).TextSize = 10
        pnl.GetView(0).SetColorAndBorder(xui.Color_Blue, 2, xui.Color_Black,0)
    Next
   
   
    B4XTable1.GridColor = xui.Color_Black
    B4XTable1_DataUpdated

'    Dim jo As JavaObject
'    jo.InitializeStatic("net.sourceforge.jtds.util.Logger").RunMethod("setActive", Array(True))  


End Sub


Private Sub Button1_Click
    If TextField1.Text.Trim <> "" Then
        Button1.Enabled = False
        TextField1.Enabled = False
       
        ImageView2.Visible = False
        Label2.Visible = False
       
    '    Label1.Text = "BO = R0.00"
    '    salesyear = ""
    '    salesmonth = ""
    '    salesyear = ComboBox1.Value
    '    If ComboBox2.Value = "Mar" Then salesmonth = "03"
    '    If ComboBox2.Value = "Apr" Then salesmonth = "04"
    '    If ComboBox2.Value = "May" Then salesmonth = "05"
    '    If ComboBox2.Value = "Jun" Then salesmonth = "06"
    '    If ComboBox2.Value = "Jul" Then salesmonth = "07"
    '    If ComboBox2.Value = "Aug" Then salesmonth = "08"
    '    If ComboBox2.Value = "Sep" Then salesmonth = "09"
    '    If ComboBox2.Value = "Oct" Then salesmonth = "10"
    '    If ComboBox2.Value = "Nov" Then salesmonth = "11"
    '    If ComboBox2.Value = "Dec" Then salesmonth = "12"
    '    If ComboBox2.Value = "Jan" Then salesmonth = "01"
    '    If ComboBox2.Value = "Feb" Then salesmonth = "02"
       

        'Connect to BFC Syspro
       
    '    Dim myURL As String = "jdbc:sqlserver://xx.x.xxx.xx:xxxx;databaseName=Syspro_Live_xxx_x;authenticationScheme=NTLM;integratedSecurity=true;domain=masterplasticsgroup.com;user=xxxxxx;password=xxxxxxxxxxx;"
    '    SQL1.Initialize("com.microsoft.sqlserver.jdbc.SQLServerDriver", myURL)

       
        Dim total As Double = 0
        SQL1.Initialize("net.sourceforge.jtds.jdbc.Driver","jdbc:jtds:sqlserver://xx.x.xxx.xx:xxxx/Syspro_Live_xx_xx;integratedSecurity=true;")
       
    '    If TextField2.Text.Length < 2 Then
    '        TextField2.Text = "0" & TextField2.text
    '    End If
       
        ProgressBar1.Alpha = 1
        ProgressBar1.Progress = 0
        ProgressBar1.Progress = -1

        'Define the Query to extract data from Syspro - data returned is available in res (Resultset)
       
        Dim myquery As String = ""
       
        Dim mybom As String = TextField1.Text
       
        myquery = "EXEC MTExplodeBOM2 " & mybom
       

        ProgressBar1.Visible = True
        Dim cs As Object = SQL1.CreateCallStatement("{call MTExplodeBOM2(?)}", Array(mybom))
        Dim res As ResultSet = SQL1.ExecCall(cs)

            Dim data As List                                                           'we are going to read the data from  the query into a list. The table will be populated from the populated list
            data.Initialize                                                            'initialize an empty list
            Do While res.NextRow
            Try  
                Sleep(0)
                Dim datarow(20) As Object
                If res.GetString("StockCode") = Null Then
                    datarow(0) = ""
                Else
                        datarow(0) = " " & res.GetString("StockCode")
                End If

                If res.GetString("StockUom") = Null Then
                    datarow(1) = ""
                Else
                    datarow(1) = "  " & res.GetString("StockUom")
                End If
               
                If res.GetString("Description") = Null Then
                    datarow(2) = ""
                Else
                    datarow(2) = "  " & res.GetString("Description")
                End If
                If res.GetString("LongDesc") = Null Then
                    datarow(3) = ""
                Else
                    datarow(3) = "  " & res.GetString("LongDesc")
                End If
                If res.GetString("Ebq") = Null Then
                    datarow(4) = ""
                Else
                    datarow(4) = "  " & NumberFormat2(res.GetString("Ebq"),0,2,2,True)
                End If
                If res.GetString("QtyPer") = Null Then
                    datarow(5) = ""
                Else
                    datarow(5) = "  " & NumberFormat2(res.GetString("QtyPer"),1,6,6,True)
                End If
                If res.GetString("PartCategory") = Null Then
                    datarow(6) = ""
                Else
                    datarow(6) = "  " & res.GetString("PartCategory")
                End If
                If res.GetString("MaterialCost") = Null Then
                    datarow(7) = ""
                Else
                    datarow(7) = "  " & "R " & NumberFormat2(res.GetString("MaterialCost"),0,2,2,True)
                End If
                If res.GetString("WorkCentre") = Null Then
                    datarow(8) = ""
                Else
                    datarow(8) = "  " & res.GetString("WorkCentre")
                End If
                If res.GetString("ISetUpTime") = Null Then
                    datarow(9) = ""
                Else
                    datarow(9) = "  " & NumberFormat2(res.GetString("ISetUpTime"),0,2,2, True)
                End If
                If res.GetString("IQuantity") = Null Then
                    datarow(10) = ""
                Else
                    datarow(10) = "  " & NumberFormat2(res.GetString("IQuantity"),0,2,2,True)
                End If
                If res.GetString("WorkCentreDesc") = Null Then
                    datarow(11) = ""
                Else
                    datarow(11) = "  " & res.GetString("WorkCentreDesc")
                End If
                If res.GetString("CreateSubJob") = Null Then
                    datarow(12) = ""
                Else
                    datarow(12) = "  " & res.GetString("CreateSubJob")
                End If
                If res.GetString("ScrapPct") = Null Then
                    datarow(13) = ""
                Else
                    datarow(13) = "  " & NumberFormat2(res.GetString("ScrapPct"),0,2,2,True) & "%"
                End If
                If res.GetString("LabourCost") = Null Then
                    datarow(14) = ""
                Else
                    datarow(14) = "  " & "R " & NumberFormat2(res.GetString("LabourCost"),0,2,2,True)
                End If
                If res.GetString("FixOverhead") = Null Then
                    datarow(15) = ""
                Else
                    datarow(15) = "  " & "R " & NumberFormat2(res.GetString("FixOverhead"),0,2,2,True)
                End If
                If res.GetString("VariableOverhead") = Null Then
                    datarow(16) = ""
                Else
                    datarow(16) = "  " & "R " & NumberFormat2(res.GetString("VariableOverhead"),0,2,2,True)
                End If
                If res.GetString("ParentTotal") = Null Then
                    datarow(17) = ""
                Else
                    datarow(17) = "  " & "R " & NumberFormat2(res.GetString("ParentTotal"),0,2,2,True)
                End If
                If res.GetString("IRunTime") = Null Then
                    datarow(18) = ""
                Else
                    datarow(18) = "  " & NumberFormat2(res.GetString("IRunTime"),0,2,2,True)
                End If
                If res.GetString("SubContractCost") = Null Then
                    datarow(19) = ""
                Else
                    datarow(19) = "  " & "R " & NumberFormat2(res.GetString("SubContractCost"),0,2,2,True)
                End If
               
                data.Add(datarow)

            Catch  
            Log(LastException)
            End Try
            Loop
            B4XTable1.SetData(data)
           

            res.Close
    '        Label1.Text = "BO = R" & NumberFormat2(total,0,2,2,True)
            SQL1.Close
            ProgressBar1.Visible = False
            B4XTable1.SearchField.TextField.TextColor = xui.Color_Red
    '        B4XTable1.SearchField.mBase.Left = 200dip                        'THIS WORKS HERE

    '    Else
    '        Log(LastException)
    '        ProgressBar1.Visible = False
    '        SQL1.Close
    '    End If

        Sleep(100)
        If B4XTable1.mCurrentCount > 0 Then
            ImageView2.Visible = True
            Label2.Visible = True
        End If
       
        Button1.Enabled = True
        TextField1.Enabled = True
    Else
        xui.MsgboxAsync("Enter a Stock Code", "ERROR")
    End If  
   
   
End Sub

Sub B4XTable1_DataUpdated
    Dim ShouldRefresh As Boolean
    For Each Column As B4XTableColumn In NameColumn                '(NameColumn(0), NameColumn(1), NameColumn(2), NameColumn(3), NameColumn(4), NameColumn(5), NameColumn(6), NameColumn(7), NameColumn(8), NameColumn(9), NameColumn(10), NameColumn(11), NameColumn(12), NameColumn(13), NameColumn(14), NameColumn(15), NameColumn(16), NameColumn(17), NameColumn(18))
        Dim MaxWidth As Int
        For i = 0 To B4XTable1.VisibleRowIds.Size
            Dim pnl As B4XView = Column.CellsLayouts.Get(i)
            Dim lbl As B4XView = pnl.GetView(0)
            lbl.SetTextAlignment("CENTER", "LEFT")
            MaxWidth = Max(MaxWidth, cvs.MeasureText(lbl.Text, lbl.Font).Width + 12dip)
        Next
        If MaxWidth > Column.ComputedWidth Or MaxWidth < Column.ComputedWidth - 20dip Then
            Column.Width = MaxWidth
            ShouldRefresh = True
        End If
    Next
    If ShouldRefresh Then
        B4XTable1.Refresh
    End If
End Sub


Private Sub Button2_Click
   
'    B4XTable1.Clear
    frm.Close
    MainMenu.Show
   
End Sub

Public Sub ExportTableToExcel(Table As B4XTable)
    Dim xl As XLUtils : xl.Initialize
    Dim Workbook As XLWorkbookWriter = xl.CreateWriterBlank
    Dim sheet1 As XLSheetWriter = Workbook.CreateSheetWriterByName("Excel Sheet Name")
   
    Dim iColumn As Int = 0

    For Each Column As B4XTableColumn In Table.Columns
        sheet1.putString(xl.AddressZero(iColumn,0),Column.Title)
        iColumn = iColumn + 1
    Next
 
    For i = 1 To Table.Size
        Dim cInt As Int = 0
        For Each Column As B4XTableColumn In Table.Columns
            Dim Row As Object = Table.GetRow(i).Get(Column.Title)
            sheet1.putString(xl.AddressZero(cInt,i),Row)
            cInt = cInt + 1
        Next
    Next
 
    Dim FileDialog As FileChooser : FileDialog.initialize
   
    FileDialog.InitialFileName = "FileName.xlsx"
    FileDialog.setExtensionFilter("Excel File", Array As String("*.xlsx"))
    FileDialog.Title = "Select where you want to save"
 
    Dim CompleteDir As String = FileDialog.ShowSave(frm)
    Dim f As String = Workbook.SaveAs(File.GetFileParent(CompleteDir), File.GetName(CompleteDir), True)
    Wait For (xl.OpenExcel(f)) Complete (Success As Boolean)
 
End Sub


Private Sub Label2_MouseClicked (EventData As MouseEvent)
    ImageView2.Visible = False
    Sleep(500)
    ImageView2.Visible = True
    ExportTableToExcel(B4XTable1)
   
End Sub

erol34 · Feb 25, 2023

Thank you so much Johan.. You shared the codes before I ask

Johan Schoeman · Feb 25, 2023

erol34 said:
Thank you so much Johan.. You shared the codes before I ask

Note that for the VBA project (Excel) I have an ODBC connection that has been set up to connect to the MSSQL database (Syspro) and I am connected to the VPN via FortiClient so that connection authentication can be done with my default username and password when logged onto the VPN.

Johan Schoeman · Feb 25, 2023

....meaning that when I am at work I am logged onto the network at work. From home I connect to the work network with FortiClient.

Johan Schoeman · Feb 25, 2023

Another example - it extracts sales data for the chosen month/year

B4X:

Private Sub CommandButton1_Click()

    Dim cn
    Dim rst
    Dim lpRM
    Dim lp
    
    Range("a6:S300000").EntireRow.Delete

    
    Application.ScreenUpdating = False
    Set cn = CreateObject("adodb.connection")
    With cn
    .provider = "sqloledb"
    .connectionstring = "server=xxx-xxx-xxx;uid=sa;Trusted_connection=yes;"
    .Open
    .defaultdatabase = "Syspro_Live_xxx_x"
    End With
    
    Set rst = CreateObject("adodb.recordset")
    With rst
    .activeconnection = cn
    .Source = "SELECT *, Name, Description FROM ArTrnDetail INNER JOIN InvMaster ON InvMaster.StockCode = ArTrnDetail.StockCode INNER JOIN ArCustomer ON ArCustomer.Customer = ArTrnDetail.Customer Where ArTrnDetail.TrnYear = '" & Sheet1.Cells(1, 2) & "' And ArTrnDetail.TrnMonth = '" & Sheet1.Cells(2, 2) & "'"
    .Open
    End With
    
    'WHERE Job='" & Me.txtJob.Text & "'"
    
    Dim teller As Integer
    teller = 6
    
    While Not rst.EOF
    
        Sheet1.Cells(teller, 1) = rst("TrnYear")
        Sheet1.Cells(teller, 2) = rst("TrnMonth")
        Sheet1.Cells(teller, 3) = rst("InvoiceDate")
        Sheet1.Cells(teller, 4) = rst("Invoice")
        Sheet1.Cells(teller, 5) = rst("Customer")
        Sheet1.Cells(teller, 6) = rst("StockCode")
        Sheet1.Cells(teller, 7) = rst("Description")
        Sheet1.Cells(teller, 8) = rst("NetSalesValue")
        Sheet1.Cells(teller, 9) = rst("QtyInvoiced")
        Sheet1.Cells(teller, 10) = rst("Mass")
        Sheet1.Cells(teller, 11) = rst("SalesPerson")
        Sheet1.Cells(teller, 12) = rst("Warehouse")
        Sheet1.Cells(teller, 13) = rst("Area")
        Sheet1.Cells(teller, 14) = rst("ProductClass")
        Sheet1.Cells(teller, 15) = rst("CostValue")
        Sheet1.Cells(teller, 16) = rst("SalesOrder")
        Sheet1.Cells(teller, 17) = rst("Name")
        Sheet1.Cells(teller, 18) = rst("NetSalesValue") - rst("CostValue")
        
        If rst("NetSalesValue") <> 0 Then
            Sheet1.Cells(teller, 19) = Sheet1.Cells(teller, 18) / rst("NetSalesValue")
        End If
        
        teller = teller + 1
        rst.MoveNext
    
    Wend
    
    Application.ScreenUpdating = True
    Set rst = Nothing
    Set cn = Nothing

End Sub

Result in Excel:

Excel (VBA) is not dead !

erol34

Member

EnriqueGonzalez

Well-Known Member

erol34

Member

Johan Schoeman

Expert

erol34

Member

aeric

Expert

Office Scripts vs VBA - Microsoft's take on VBA in 2022 - Analyst Cave

Johan Schoeman

Expert

Johan Schoeman

Expert

Johan Schoeman

Expert

erol34

Member

Johan Schoeman

Expert

Johan Schoeman

Expert

Johan Schoeman

Expert

Excel (VBA) is not dead !

Member

Well-Known Member

Member

Expert

Member

Expert

Expert

Expert

Expert

Member

Expert

Expert

Expert

Privacy & Transparency

Privacy & Transparency