1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| Public Function Pc_Connect(strBdd As String) On Error GoTo Err_Pc_Connect
'Déclarations des variables
Dim intLDB As Integer, i As Integer
Dim strChemin As String
Dim Nom_PC As String
Dim utilisateur As Un_Connecte
Dim DB As Database
Dim strTemp As String
'Inhibe les messages d'erreurs
DoCmd.SetWarnings False
'Vide la Tables contenant la liste des pc connectés
DoCmd.RunSQL "DELETE * FROM tblConnectes"
'Change l'extension du chemin par ldb au lieu de mdb
strChemin = Left(strBdd, InStr(1, strBdd, ".")) + "LDB"
'Designe le numéro pour le fichier
intLDB = FreeFile
'Ouvre le fichier ldb
Open strChemin For Binary Access Read Shared As intLDB
'Boucle permettant de lire l'ensemble du fichier ldb
Do While Not EOF(intLDB)
'Chaque enregistrement lu est placé dans la variable utilisateur pour y être inésrée dans un table.
Get intLDB, , utilisateur
With utilisateur
i = 1
Nom_PC = ""
'nom du PC
While .PC(i) <> 0
Nom_PC = Nom_PC & Chr(.PC(i))
i = i + 1
Wend
End With
'Contrôle si chaîne supérieur à 0 caractères et insertion valeur dans tables
If Len(Nom_PC) > 0 Then
DoCmd.RunSQL ("INSERT INTO tblConnectes (Connectes) VALUES('" & Nom_PC & "');")
DoCmd.SetWarnings True
End If
Loop
'Fermeture du fichier ldb
Close intLDB
Exit Function
Err_Pc_Connect:
MsgBox err.Number & vbCrLf & err.Description, vbInformation, "Erreur"
Close intLDB
End Function |
Partager