我正在嘗試創建一個 VBA 例程來從 MS Access 資料庫表中匯出一些資料。資料由另一個系統使用，因此需要采用特定格式，類似于 PIVOT 表。
該代碼運行良好，但存在一個問題。某些欄位在用于創建 PIVOT 表的 TRANSFORM 命令后回傳 NULL 值。下面是查詢 VW_DEMAND_XL 的 SQL 陳述句
TRANSFORM FIRST([VALUE])
SELECT STRLOC AS ROWNAMES, [DESC] AS [TEXT], CODE
FROM TB_DEMAND_PVT
GROUP BY STRLOC, [DESC], CODE
PIVOT [PARAMETER] & PERIOD;
周期數是可變的。
此查詢由執行匯出部分的 VBA 代碼呼叫：
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 是一個以適當格式創建表以使用 TRANSFORM 命令的查詢。
我嘗試使用以下代碼在 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
但是當有 NULL 值時，我會遇到運行時錯誤 3027（無法更新。資料庫或物件是只讀的）。
有人可以指出我做錯了什么嗎？有可能做我想做的事嗎？
此致
uj5u.com熱心網友回復：
您的基礎記錄集不可更新，并且您的 Null 處理代碼正試圖實際更改記錄集中欄位的值。正如@Nathan_Sav 建議的那樣，在遇到 Null 時使用 Nz() 函式回傳 0。
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/497868.html