MS Access Query ColumnHidden недвижимости

Обновить

April 2019

Просмотры

237 раз

1

I've written some VBA code that (a) sets the SQL of a query based on input variables, (b) opens the query in datasheet view, and (c) hides or shows columns based on "true" / "false" values of check boxes in another table. This is considering the "ColumnHidden" property as described in Microsoft Dev Center help. Dev Center Help - ColumnHidden Property

When executing the code, (a) and (b) are working as intended. However, I get error 3270, "Property not found" at line fld.Properties("ColumnHidden") = False when executing (c). I've been unable to resolve the issue, even when trying the error handling method described in the Dev Center. Please help!

Dim rsLabel As DAO.Recordset, rsCOlumn As DAO.Recordset
Dim qryCPQ As DAO.QueryDef
Dim strLabel As String, strSQL As String, strColumn As String
Dim fld As DAO.Field
Dim dbs As DAO.Database
Dim prp As DAO.Property
Dim AttArray As Variant
Dim x As Integer


ReDim AttArray(19, 1)
For x = 1 To 20
    AttArray(x - 1, 1) = "Att" & x
Next x

strLabel = "SELECT * FROM PM_qryLabels2 WHERE CAT_ID=" & Forms!CM_frmCollectionReportPre!cboFamily
Set rsLabel = CurrentDb.OpenRecordset(strLabel, dbOpenSnapshot)
rsLabel.MoveFirst

For x = 1 To 20
    If Not IsNull(rsLabel.Fields("Att" & x)) Then
        AttArray(x - 1, 1) = rsLabel.Fields("Att" & x)
    Else
        AttArray(x - 1, 1) = "Att" & x
    End If
Next x


With CurrentDb
    Set qryCPQ = .QueryDefs("CM_qryCollectionReport")

    strSQL = "SELECT CM_qryCollectionEdit2.CATEGORY, CM_qryCollectionEdit2.Part_No, CM_qryCollectionEdit2.CPQ_Material, CM_qryCollectionEdit2.CPQ_LaborMach, CM_qryCollectionEdit2.CPQ_LaborAssy, CM_qryCollectionEdit2.CPQ_LaborPipe, CM_qryCollectionEdit2.CPQ_LaborTest, CM_qryCollectionEdit2.CPQ_LaborPack, CM_qryCollectionEdit2.CPQ_LaborShip, CM_qryCollectionEdit2.CPQ_Sub, " & _
             "PM_qryOptions.Att1 As [" & AttArray(0, 1) & "], PM_qryOptions.Att2 As [" & AttArray(1, 1) & "], PM_qryOptions.Att3 As [" & AttArray(2, 1) & "], PM_qryOptions.Att4 As [" & AttArray(3, 1) & "], PM_qryOptions.Att5 As [" & AttArray(4, 1) & "], PM_qryOptions.Att6 As [" & AttArray(5, 1) & "], PM_qryOptions.Att7 As [" & AttArray(6, 1) & "], PM_qryOptions.Att8 As [" & AttArray(7, 1) & "], PM_qryOptions.Att9 As [" & AttArray(8, 1) & "], PM_qryOptions.Att10 As [" & AttArray(9, 1) & "], PM_qryOptions.Att11 As [" & AttArray(10, 1) & "], PM_qryOptions.Att12 As [" & AttArray(11, 1) & "], PM_qryOptions.Att13 As [" & AttArray(12, 1) & "], PM_qryOptions.Att14 As [" & AttArray(13, 1) & "], PM_qryOptions.Att15 As [" & AttArray(14, 1) & "], PM_qryOptions.Att16 As [" & AttArray(15, 1) & "], PM_qryOptions.Att17 As [" & AttArray(16, 1) & "], PM_qryOptions.Att18 As [" & AttArray(17, 1) & "], PM_qryOptions.Att19 As [" & AttArray(18, 1) & "], PM_qryOptions.Att20 As [" & AttArray(19, 1) & "] " & _
             "FROM CM_qryCollectionEdit2 INNER JOIN PM_qryOptions ON CM_qryCollectionEdit2.Part_No = PM_qryOptions.Part_No " & _
             "WHERE ((CM_qryCollectionEdit2.CAT_ID)=" & Me.cboFamily & " AND ((CM_qryCollectionEdit2.CPQ_Publish)=True));"
    qryCPQ.SQL = strSQL
    qryCPQ.Close
    Set qryCPQ = Nothing
End With

DoCmd.OpenQuery "CM_qryCollectionReport", , acReadOnly

Set dbs = CurrentDb

For x = 1 To 20
    Set fld = dbs.QueryDefs!CM_qryCollectionReport.Fields(AttArray(x - 1, 1))
    fld.Properties("ColumnHidden") = False

    strColumn = "SELECT * FROM PM_Attributes WHERE CAT_ID=" & Forms!CM_frmCollectionReportPre!cboFamily & " AND [ATTRIBUTE]='" & AttArray(x - 1, 1) & "'"
    Set rsCOlumn = CurrentDb.OpenRecordset(strColumn, dbOpenSnapshot)

    If Not rsCOlumn.EOF Then
        If rsCOlumn![CPQ_Publish] = False Then
            fld.Properties("ColumnHidden") = True
        End If
    End If

    rsCOlumn.Close
    Set rsCOlumn = Nothing
    Set fld = Nothing
Next x


Set dbs = Nothing

DoCmd.Close acForm, "CM_frmCollectionReportPre", acSaveNo

За предложение Эрика фон Asmuth, я уже добавил в обработке ошибок, поэтому код в настоящее время выглядит следующим образом. Тем не менее, я все еще получаю ошибку 3270 на том же месте. Не исправил вещь.

Dim rsLabel As DAO.Recordset, rsCOlumn As DAO.Recordset
Dim qryCPQ As DAO.QueryDef
Dim strLabel As String, strSQL As String, strColumn As String
Dim fld As DAO.Field
Dim dbs As DAO.Database
Dim prp As DAO.Property
Dim AttArray As Variant
Dim x As Integer
Const conErrPropertyNotFound = 3270

' Turn off error trapping
On Error Resume Next

ReDim AttArray(19, 1)
For x = 1 To 20
    AttArray(x - 1, 1) = "Att" & x
Next x

strLabel = "SELECT * FROM PM_qryLabels2 WHERE CAT_ID=" & Forms!CM_frmCollectionReportPre!cboFamily
Set rsLabel = CurrentDb.OpenRecordset(strLabel, dbOpenSnapshot)
rsLabel.MoveFirst

For x = 1 To 20
    If Not IsNull(rsLabel.Fields("Att" & x)) Then
        AttArray(x - 1, 1) = rsLabel.Fields("Att" & x)
    Else
        AttArray(x - 1, 1) = "Att" & x
    End If
Next x

'AFTER FORM IS OPEN, NEED TO HIDE COLUMNS BASEDON CPQ_PUBLISH

With CurrentDb
    Set qryCPQ = .QueryDefs("CM_qryCollectionReport")

    strSQL = "SELECT CM_qryCollectionEdit2.CATEGORY, CM_qryCollectionEdit2.Part_No, CM_qryCollectionEdit2.CPQ_Material, CM_qryCollectionEdit2.CPQ_LaborMach, CM_qryCollectionEdit2.CPQ_LaborAssy, CM_qryCollectionEdit2.CPQ_LaborPipe, CM_qryCollectionEdit2.CPQ_LaborTest, CM_qryCollectionEdit2.CPQ_LaborPack, CM_qryCollectionEdit2.CPQ_LaborShip, CM_qryCollectionEdit2.CPQ_Sub, " & _
                        "PM_qryOptions.Att1 As [" & AttArray(0, 1) & "], PM_qryOptions.Att2 As [" & AttArray(1, 1) & "], PM_qryOptions.Att3 As [" & AttArray(2, 1) & "], PM_qryOptions.Att4 As [" & AttArray(3, 1) & "], PM_qryOptions.Att5 As [" & AttArray(4, 1) & "], PM_qryOptions.Att6 As [" & AttArray(5, 1) & "], PM_qryOptions.Att7 As [" & AttArray(6, 1) & "], PM_qryOptions.Att8 As [" & AttArray(7, 1) & "], PM_qryOptions.Att9 As [" & AttArray(8, 1) & "], PM_qryOptions.Att10 As [" & AttArray(9, 1) & "], PM_qryOptions.Att11 As [" & AttArray(10, 1) & "], PM_qryOptions.Att12 As [" & AttArray(11, 1) & "], PM_qryOptions.Att13 As [" & AttArray(12, 1) & "], PM_qryOptions.Att14 As [" & AttArray(13, 1) & "], PM_qryOptions.Att15 As [" & AttArray(14, 1) & "], PM_qryOptions.Att16 As [" & AttArray(15, 1) & "], PM_qryOptions.Att17 As [" & AttArray(16, 1) & "], PM_qryOptions.Att18 As [" & AttArray(17, 1) & "], PM_qryOptions.Att19 As [" & AttArray(18, 1) & "], PM_qryOptions.Att20 As [" & AttArray(19, 1) & "] " & _
                "FROM CM_qryCollectionEdit2 INNER JOIN PM_qryOptions ON CM_qryCollectionEdit2.Part_No = PM_qryOptions.Part_No " & _
                "WHERE ((CM_qryCollectionEdit2.CAT_ID)=" & Me.cboFamily & " AND ((CM_qryCollectionEdit2.CPQ_Publish)=True));"
    qryCPQ.SQL = strSQL
    qryCPQ.Close
    'Set qryCPQ = Nothing
End With

DoCmd.OpenQuery "CM_qryCollectionReport", , acReadOnly

Set dbs = CurrentDb

For x = 1 To 20
    Set fld = dbs.QueryDefs!CM_qryCollectionReport.Fields(AttArray(x - 1, 1))
    fld.Properties("ColumnHidden") = False

    ' Error may have occurred when value was set.
    ' Display error message or create property when property didn't exist
    If Err.Number <> 0 Then
        If Err.Number <> conErrPropertyNotFound Then
            On Error GoTo 0
            MsgBox "Couldn't set property 'ColumnHidden' " & _
                   "on field '" & fld.Name & "'", vbCritical
        Else
            On Error GoTo 0
            Set prp = fld.CreateProperty("ColumnHidden", dbLong, False)
            fld.Properties.Append prp
        End If
    End If


    strColumn = "SELECT * FROM PM_Attributes WHERE CAT_ID=" & Forms!CM_frmCollectionReportPre!cboFamily & " AND [ATTRIBUTE]='" & AttArray(x - 1, 1) & "'"
    Set rsCOlumn = CurrentDb.OpenRecordset(strColumn, dbOpenSnapshot)

    If Not rsCOlumn.EOF Then
        If rsCOlumn![CPQ_Publish] = False Then
            fld.Properties("ColumnHidden") = True
        End If
    End If

    rsCOlumn.Close
    Set rsCOlumn = Nothing
    Set fld = Nothing
    Set prp = Nothing
Next x

Set dbs = Nothing

DoCmd.Close acForm, "CM_frmCollectionReportPre", acSaveNo

Снимки экрана ошибки:

введите описание изображения здесь

введите описание изображения здесь

1 ответы

0

If you closely look at the example code in the article you referred to, it includes error capturing, and creating the property if it didn't exist. This is because the property may or may not exist based on unpredictable circumstances.

Adapted from the Linked article:

 Const conErrPropertyNotFound = 3270

' Turn off error trapping.
On Error Resume Next

'Set the field to false here
fld.Properties("ColumnHidden") = False

' Error may have occurred when value was set.
' Display error message or create property when property didn't exist
If Err.Number <> 0 Then
    If Err.Number <> conErrPropertyNotFound Then
        On Error GoTo 0
        MsgBox "Couldn't set property 'ColumnHidden' " & _
               "on field '" & fld.Name & "'", vbCritical
    Else
        On Error GoTo 0
        Set prp = fld.CreateProperty("ColumnHidden", dbLong, False)
        fld.Properties.Append prp
    End If
End If

Since you've already set the field to False, you don't need to error trap in case the field doesn't exist when setting it back to True

You can also choose to check if the property does exist by iterating through all properties, which is best done in a separate function. This avoids error trapping, but may take longer to run