Proprietà non trovata errore 3270

Private Sub Form_Close()
On Error GoTo Errore
     'scrive e salva le proprietà
  procSetCreatePrp "Forms", Me.Name, Me!SerialeHD.Name, Me!SerialeHD
  procSetCreatePrp "Forms", Me.Name, Me!UsName.Name, Me!UsName
  
ExitErrore:
Exit Sub

Errore:
MsgBox Err.Description
Resume ExitErrore
  
End Sub

Private Sub Form_Open(Cancel As Integer)
On Error GoTo Errore
    Dim MostraNome As String
    
    'chiude la splash
   DoCmd.Close acForm, "SplashScreen"
   
     MostraNome = Environ("UserName")
  
' 'legge le proprietà
  Me!SerialeHD = fctGetPrp("Forms", Me.Name, Me!SerialeHD.Name)
  Me!UsName = fctGetPrp("Forms", Me.Name, Me!UsName.Name)

    With Me
'controlla quanto è scritto nelle due caselle di testo
    If .SerialeHD = "ZZZZZZ" And .UsName = "ZZZZZZ" Then
      .UsName = MostraNome
      .SerialeHD = GetSerialNumber
    End If

'in caso di non corrispondenza con quanto scritto nelle proprietà mostra messaggio
' e chiude l'applicazione
    If .SerialeHD <> "ZZZZZZ" And .UsName <> "ZZZZZZ" Then
      If .UsName <> MostraNome Or .SerialeHD <> GetSerialNumber Then
          MsgBox "Non si dispone delle credenziali adatte a far funzionare il programma." _
          & vbCrLf & vbCrLf & "Tentativo di copiare l'applicazione" _
          & vbCrLf & vbCrLf & "L'applicazione verrà chiusa", vbCritical, "Entriamo in azienda 4 - Attenzione"
          Cancel = True
          'per chiudere l'applicazione usare application.quit
          Application.Quit
          Exit Sub
       End If
    End If
    End With
    
ExitErrore:
Exit Sub

Errore:
MsgBox Err.Description
Resume ExitErrore

End Sub
-------------------------
Sub procSetCreatePrp(strObjType As String, strObjName As String, strPrpName As String, strValue As String)
'crea le proprietà
On Error GoTo ErrPrp

  Dim db As DAO.Database
  Dim doc As DAO.Document

  Set db = CurrentDb
  Set doc = db.Containers(strObjType).Documents(strObjName)

  doc.Properties(strPrpName) = strValue

ExitPrp:
Exit Sub

ErrPrp:

  Select Case Err.Number
    Case 3270 ' Property non è ancora presente
      doc.Properties.Append doc.CreateProperty(strPrpName, dbText, strValue)
    Case Else
      MsgBox "Eccezione divertente " & Err.Number & " vuol dire: " & Err.Description
  End Select

Resume ExitPrp

End Sub
---------------------------------------
Function fctGetPrp(strObjType As String, strObjName As String, strPrpName As String)
''imposta le proprietà
On Error GoTo ErrPrp
  
 fctGetPrp = CurrentDb.Containers(strObjType).Documents(strObjName).Properties(strPrpName)

ExitPrp:
Exit Function

ErrPrp:
'controlla se l'applicazione è stata già installata o è la prima installazione
 If intMsg = 1 Then
  Else
     MsgBox "Primo utilizzo" & vbCrLf & vbCrLf & "Buon lavoro !" & vbCrLf & vbCrLf & "OK per continuare ", vbInformation, "Entriamo in azienda 4 - Info"
  End If
  intMsg = 1
End Function