Search code examples
sqlvbams-accesspivotrecordset

Replace NULL with Zeros MS ACCESS PIVOT


I'm trying to create a VBA routine to export some data from a MS Access Database table. The data is used by another system and, for this reason, needs to be in a specific format, similar to a PIVOT Table.
The code works well but there is an issue. Some fields are returning NULL values after the TRANSFORM command used to create the PIVOT table. Below is the SQL statement for the query VW_DEMAND_XL

TRANSFORM FIRST([VALUE])
SELECT STRLOC AS ROWNAMES, [DESC] AS [TEXT], CODE
FROM TB_DEMAND_PVT
GROUP BY STRLOC, [DESC], CODE
PIVOT [PARAMETER] & PERIOD;

The number of periods are variable.
This query is called by VBA code that does the export part:

Private Sub BTN_EXPORTA_DEMAND_Click()

'https://btabdevelopment.com/export-tablequery-to-excel-to-new-named-sheet/
'
 Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
    
    Dim SFile As String
    Dim SName As String
    Dim QueryNM As String
    Dim SheetNM As String
    Dim TableNM As String
    
    TableNM = "TB_DEMAND_XL"
    
    'Verifica se a tabela existe. Se existir, ela é eliminada.
    Importa.DeleteIfExists (TableNM)
    
    'Desliga os avisos
    DoCmd.SetWarnings False
    'Executa a consulta e cria a tabela
    DoCmd.OpenQuery "CT_DEMAND_PVT"
    'Liga os Avisos
    DoCmd.SetWarnings True
    
    QueryNM = "VW_DEMAND_XL"
    SheetNM = "DEMAND"
    
    SPath = Application.CurrentProject.Path
    DH = Format(Now, "ddmmyyyy_hhmmss")
    SFile = "\" & SheetNM & "_" & DH & ".xlsx"
    SName = SPath & SFile
    
    Set rst = CurrentDb.OpenRecordset(QueryNM)

    'NULL values check was put here'

    Set ApXL = CreateObject("Excel.Application")

    'Adiciona o arquivo Excel de destino
    Set xlWBk = ApXL.Workbooks.Add
    
    ApXL.Visible = False
    'Salva o arquivo com o nome desejado
    xlWBk.SaveAs FileName:=SName
    
    xlWBk.Worksheets("Planilha1").Name = SheetNM
    Set xlWSh = xlWBk.Worksheets(SheetNM)

    xlWSh.Activate
    'Cria os indícies da tabela
    xlWSh.Range("A1") = "TABLE"
    xlWSh.Range("B1") = "DEMAND"
    xlWSh.Range("A2") = "*"
    
    'Seleciona a primeira célula
    xlWSh.Range("A3").Select
    'Cola os rótulos
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
    xlWSh.Range("C3") = "!CODE"
    
    rst.MoveFirst
    'Seleciona a próxima linha e cola os dados
    xlWSh.Range("A4").CopyFromRecordset rst

    xlWSh.Range("3:3").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With

    ApXL.Selection.Font.Bold = True

    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With

    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select

    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit

    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
    
    xlWBk.Save
    xlWBk.Close

    rst.Close

    Set rst = Nothing
    
    MsgBox ("Arquivo exportado!")

Exit_SendTQ2XLWbSheet:
    Exit Sub

err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
End Sub

CT_DEMAND_PVT is a query that creates a table in the adequate format to use TRANSFORM command.

I've tried to use the following piece of code to handle NULL values just after the Set rst = CurrentDb.OpenRecordset(QueryNM).

    With rst
    
    .MoveFirst
    Dim objfield
        Do While Not .EOF
            For Each objfield In .Fields
                If IsNull(objfield.Value) Then
                    .Edit
                    objfield.Value = 0
                    .Update
                End If
            Next objfield
        .MoveNext
        Loop
    .MoveFirst
   End With

But when there are NULL values, I've got a runtime error 3027 (Cannot update. Database or object is read-only).

Can someone point what I'm doing wrong? Is it possible to do what I want?
Best regards


Solution

  • Your underlying recordset is not updateable and your Null handling code is attempting to actually change the values of the fields in the recordset. As @Nathan_Sav suggests, use the Nz() function to return 0 when you encounter Nulls.