OCULTAR CAMPOS DE UMA TABELA DO ACCESS VIA VB

Public Sub AbreBanco(NomeDoBanco As String)
NomeBanco2 = NomeDoBanco
Dim nome As String
Dim i As Integer
Dim Y As Integer
Dim R As Integer
'Dim RecTMP2 As Recordset
Set WS = DBEngine.Workspaces(0)
Set Banco = DBEngine.OpenDatabase(NomeDoBanco, False, False, ";pwd=" & EsconderDados.Sh.Text)         ', True, False)
For i = 0 To Banco.TableDefs.Count - 1
'MsgBox Banco.TableDefs(i).Attributes
  If Mid(Banco.TableDefs(i).Name, 1, 4) <> "MSys" Then
   EsconderDados.Lst1.AddItem Banco.TableDefs(i).Name
    EsconderDados.Lst1.ItemData(EsconderDados.Lst1.NewIndex) = i
    'For Y = 0 To Banco.TableDefs(i).Fields.Count
        'For r = 0 To Banco.TableDefs(i).Fields(Y).Properties.Count
        'On Error Resume Next
            'Form1.Lst2.AddItem Banco.TableDefs(i).Fields(Y).Properties(r).Name & " =>> " _
            '& Banco.TableDefs(i).Fields(Y).Properties(r).Value & " = " & r
            ''Form1.Lst2.AddItem Banco.TableDefs(i).Fields(Y).Properties(r).Inherited
            ''Form1.Lst2.AddItem Banco.TableDefs(i).Fields(Y).Properties(r).Properties
            ''Form1.Lst2.AddItem Banco.TableDefs(i).Fields(Y).Properties(r).Type
        'On Error GoTo 0
        'Next r
        'Form1.Lst2.AddItem " "
        'Banco.TableDefs(i).Fields(Y).Properties(22).Value = False
        'Form1.Lst2.AddItem Banco.TableDefs(i).Fields(Y).Name '& " => " & Banco.TableDefs(i).Fields(Y).Value
        ' = 1
    'Next Y
  End If
Next i
'Set REctMeu = Banco.OpenRecordset("select * from nr", dbOpenDynaset)
'For i = 0 To REctMeu.Fields.Count
'On Error Resume Next
'If REctMeu.Fields(i).Value <> "" Then Form1.Lst2.AddItem REctMeu.Fields(i).Name & " =>> " & REctMeu.Fields(i).Value
'On Error GoTo 0
'Next i
ErroMeu:
If Err.Number = 3024 Then
    MsgBox "O Banco de dados " & "''" & NomeDoBanco & "''" & " não existe ou foi removido!", vbExclamation + vbCritical, "Erro"

ElseIf Err.Number = 3045 Then
  MsgBox "O Banco de Dados " & "''" & Trim(NomeDoBanco) & "''" & "  Já esta sendo usado!" & vbCrLf & "Erro Número: " & Err.Number & vbCrLf & "Descrição :" & Err.Description & vbCrLf & "Tente fechar o Programa que esta com o banco de dados aberto e se o problema continuar tente REINICIAR o Computador.", vbExclamation
'End


ElseIf Err <> 0 Then
MsgBox "Erro Número: " & Err.Number & vbCrLf & "Descrição: " & Err.Description
'End
End If

End Sub

Private Sub Chk1_Click()
XpBs2.Enabled = True
End Sub

Private Sub Form_Load()

End Sub

Private Sub Lst1_Click()
Dim i As Integer, Y As Integer
If Banco.TableDefs(Lst1.ItemData(Lst1.ListIndex)).Attributes < 0 Or Banco.TableDefs(Lst1.ItemData(Lst1.ListIndex)).Attributes = 2 Then
  Chk1.Value = 1
Else
  Chk1.Value = 0
End If
XpBs2.Enabled = False

End Sub

Private Sub Lst2_Click()
On Error Resume Next
Dim i As Integer
If Banco.TableDefs(Lst2.ItemData(Lst1.ListIndex)).Fields(Lst2.ItemData(Lst2.ListIndex)).Properties(19).Value = True Then
  Chk1.Value = 1
Else
  Chk1.Value = 0
End If
Err = 0
End Sub

Private Sub XpBs1_Click()
Dialog.Filter = "Arquivos de Banco de Dados .Mdb" & Chr(0) & "*.Mdb" & Chr(0) & "Todos os Arquivos *.*" & Chr(0) & "*.*"

Dialog.ShowOpen Me
If Dialog.FileName <> "" Then
  If ExisteArq(Dialog.FileName) Then
    Lst1.Clear
    Chk1.Value = 0
    AbreBanco Dialog.FileName
    Txt = Dialog.FileName
    
  End If
End If

End Sub

Private Sub XpBs2_Click()
If Lst1.ListIndex >= 0 Then
  If Chk1.Value > 0 Then
  Banco.TableDefs(Lst1.ItemData(Lst1.ListIndex)).Attributes = dbEncrypt
  Else
  Banco.TableDefs(Lst1.ItemData(Lst1.ListIndex)).Attributes = 0
  End If
End If
XpBs2.Enabled = False

End Sub