Base de donne ACCESS

Question

J aimerais savoir comment faire pour creer a partir de vb la structure d une base de donne (par programmation, sans passer par le gestionnaire de donnee)
J aimerais egalement savoir comment lire des champs d une base de donnee sans passer par un TextBox ou un EditBox

Merci d avance

noisy · Answer

POur ta première question, je ne vois pas où tu veux en venir... Personellement, quand je crée une BDD, je passe pas Access...
Pour la 2eme question, tu peux passer par un DataGrid (le plus simple d'utilisation) il s'agit d'un tableau qui se remplira automatiquement si tu lui met comme datasource ta base de donnée.
Pour l'avoir, passes par l'ajout de composant habituel et c'est: "Microsoft DataGrid Control 6.0" ou un truc du genre
Mais tu as des tas de possibilités différentes

eltaris · Answer

Le problème c'est qu'il est possible de créer 
une bd uniquement avec du code (en déclarant une 
variable de type Database), mais ce type n'apparait pas
sous vb mais sous vba Access.
Je ne crois que cela soit possible en vb (rq: je peux
me tromper, je suis loin de connaitre vb par coeur)

Makabey · Answer

1. Vas sous le menu Project->References..., sélectionne "Microsoft DAO 3.x Object Librairy" où '3.x' varie selon ce que tu as d'installé, moi pour VB6 SP5 j'ai le choix entre 2.5, 3.5 et 3.6; maintenant tu as accès à tout les objets pour créer une BD compatible Access97.

2. Le code suivant devrait t'aider:

Public Function CreerBDPersos(ByVal InNomFichier As String) As Integer
  '
  ' Crée sous le nom InNomFichier une base de données
  ' Access97.
  '
  ' InNomFichier : nom de fichier à utiliser quand il aura été créé.
  '
  '
  ' Retourne un code erreur:
  '   0: Ok
  '   1: Fichier existe déjà
  '   2: Une des tables n'as pas pu être créée.
  '
  Dim WSTemp1 As Workspace
  Dim BDTemp1 As Database
  Dim Table1 As TableDef
  Dim iRetour As Integer
  Dim RSTemp1 As Recordset
  Dim boTblErreur As Boolean
  Dim iCmpt As Integer
  
  
  On Error GoTo ErrHndCBDPrs
  
  'Le fichier existe?
  If (FileOrDirExists(InNomFichier)) Then
      CreerBDPersos = 1
      Exit Function
    'Else
  End If
  
  'Création...
  Set WSTemp1 = DBEngine.Workspaces(0)
  Set BDTemp1 = WSTemp1.CreateDatabase(InNomFichier, dbLangGeneral, dbVersion30)
  
  'Table General1
  Set Table1 = BDTemp1.CreateTableDef("General1")
  iRetour = CreerBDPersosTableGeneral1(Table1)
  If (iRetour > 0) Then  'Table mal créée?
      boTblErreur = True
      Err.Raise 91 'Arbitraire...
    'Else
  End If
  'Ajout de la table dans la BD...
  BDTemp1.TableDefs.Append Table1
  Set Table1 = Nothing
 
  'Fin...
  BDTemp1.Close
  
  Exit Function

ErrHndCBDPrs:
  BDTemp1.Close
  'Le fichier existe?
  If (FileOrDirExists(InNomFichier)) Then
      Kill InNomFichier
      Exit Function
    'Else
  End If
  
  If boTblErreur Then
      CreerBDPersos = iRetour
    Else
      CreerBDPersos = Err.Number
  End If

End Function

Private Function CreerBDPersosTableGeneral1(ByRef InTable As TableDef) As Integer
  '
  ' Essai de séparation de la création des différentes tables
  ' si ça fct, alors la function sera plus facile à éditer :)
  '
  ' Conception de la table General1
  '
  Dim Champs1 As Field
  Dim ChampIndex1 As Field
  Dim Index1 As Index
  
  
  On Error GoTo ErrHndCreerBDPersosTableGeneral1
  
  Set Champs1 = InTable.CreateField("NumeroEntree", dbLong)
  Champs1.Attributes = dbAutoIncrField
  InTable.Fields.Append Champs1
  'Le bloc qui suit est pour créer une "primary key"
  Set Index1 = InTable.CreateIndex("NumeroEntree")
  Index1.Primary = True
  Index1.Unique = True
  Set ChampIndex1 = Index1.CreateField("NumeroEntree")
  Index1.Fields.Append ChampIndex1
  InTable.Indexes.Append Index1
  
  Set Champs1 = InTable.CreateField("Nom", dbText, 50)
  InTable.Fields.Append Champs1
  
  Exit Function

ErrHndCreerBDPersosTableGeneral1:
  CreerBDPersosTableGeneral1 = Err.Number

End Function

'Les déclarations et fonctions qui suivent sont pour 
'le soutient et on aucun rapport avec la création en
'tant que tel...

'Pour fonction FileOrDirExists
Public Const MAX_PATH = 260
Private Const ERROR_NO_MORE_FILES = 18&
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
  (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
  (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Function FileOrDirExists(Optional ByVal sFile As String "", Optional ByVal sFolder As String "") As Boolean
  '
  ' Trouvé sur le Net
  '
  ' Retourne VRAI si le fichier ou répertoire passé existe
  '
  '
  ' Exemple:
  '   // test if file exists
  '   If FileOrDirExists("c:\temp.txt") Then
  '       MsgBox "The file 'C:\temp.txt' exists"
  '     Else
  '       MsgBox "The file 'C:\temp.txt' does not exist"
  '   End If
  '
  '   // test if folder exists
  '   If FileOrDirExists(, "c:\test directory") Then
  '       MsgBox "The folder 'c:\test directory' exists"
  '     Else
  '       MsgBox "The folder 'c:\test directory' does not exist"
  '   End If
  '
  Dim lpFindFileData As WIN32_FIND_DATA
  Dim lFileHdl As Long
  Dim sTemp As String
  Dim sTemp2 As String
  Dim lRet As Long
  Dim iLastIndex As Integer
  Dim sStartDir As String
    
    
  On Error Resume Next
    
  '// both params are empty  If sFile "" And sFolder "" Then Exit Function
  
  '// both are full, empty folder param
  If sFile <> "" And sFolder <> "" Then sFolder = ""
  
  If sFolder <> "" Then
      '// set start directory
      sStartDir = sFolder
    Else
      '// extract start directory from file path
      sStartDir = Left$(sFile, InStrRev(sFile, ""))
      
      '// just get filename
      sFile = Right$(sFile, Len(sFile) - InStrRev(sFile, ""))
  End If
  
  '// add trailing \ to start directory if required
  If Right$(sStartDir, 1) <> "" Then sStartDir = sStartDir & ""
  
  sStartDir = sStartDir & "*.*"
    
  '// get a file handle
  lFileHdl = FindFirstFile(sStartDir, lpFindFileData)
    
  If lFileHdl <> -1 Then
      If sFolder <> "" Then
          '// folder exists
          FileOrDirExists = True
        Else
          Do Until lRet = ERROR_NO_MORE_FILES
            
            '// if it is a file
            If (lpFindFileData.dwFileAttributes And FILE_ATTRIBUTE_NORMAL) = vbNormal Then
                sTemp = StrConv(StripTerminator(lpFindFileData.cFileName), vbProperCase)
                '// remove LCase$ if you want the search to be case sensitive (unlikely!)
                If LCase$(sTemp) = LCase$(sFile) Then
                    FileOrDirExists = True '// file found
                    Exit Do
                  'Else
                End If
              'Else
            End If
            
            '// based on the file handle iterate through all files and dirs
            lRet = FindNextFile(lFileHdl, lpFindFileData)
            If lRet = 0 Then Exit Do
          Loop
        'Else
      End If
    'Else
  End If
    
  '// close the file handle
  lRet = FindClose(lFileHdl)
  
End Function

Function StripTerminator(ByVal strString As String) As String
  'Pour fonction FileOrDirExists
  Dim intZeroPos As Integer
  
  intZeroPos = InStr(strString, Chr$(0))
  If intZeroPos > 0 Then
      StripTerminator = Left$(strString, intZeroPos - 1)
    Else
      StripTerminator = strString
  End If
  
End Function

Base de donne ACCESS

3 réponses

Discussions similaires