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
CodePudding user response:
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.