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 61 62 63 64 65 66 67 68 69 70 71
| Sub NomDeTaFonction()
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset, oPS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
Dim Fichier As String, Repertoire As String
Repertoire = "C:\NomRepertoireDeStockDesFichiersExcel"
'Tu stocke dans Fichier tous les noms de fichiers dans ton répertoire et se terminant par xls
Fichier = Dir(Repertoire & "\*.xls")
'Connection à la Base Access
Set oConn = CurrentProject.Connection
'Connection à ta table resultat_controle
Set oRS = New ADODB.Recordset
oRS.Open "Select * from resultat_controle", oConn, adOpenKeyset, adLockOptimistic
Set oPS = New ADODB.Recordset
oPS.Open "Select * from Num_de_lot", oConn, adOpenKeyset, adLockOptimistic
'Parcours de tous les fichiers xls du répertoire
Do While Fichier <> ""
'Connection au classeur Excel
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Repertoire & "\" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;"""
'Connection à la feuille nommé FeuilName dans ton fichier excel, pour automatiser cela il serait préférable qu'a chaque nouveau fichier tes feuilles aient le même nom
oProdRS.Open "SELECT * FROM [" & FeuilName & "] ", Cn, adOpenStatic
'Boucle sur les lignes de ta feuille excel
Do While Not (oProdRS.EOF)
'On stocke le numéro du lot de la ligne excel dans une variable
Num_lot = oProdRS.Fields(0)
'Test si le numéro de lot de ta ligne est dans ta table
If Isnull(Dlookup("[ChampNumLot]","TableNumLot", "[ChampNumLot] = '" & Num_lot & "' ") then
'Donc si ce numéro de lot n'est pas dans ta table, tu crée une nouvelle ligne et tu le mets dedans
oPS.Addnew
oPS.Fields(0) = Num_lot
'Si d'autres infos à mettre dans la table Num_de_lot il suffit de remplacer le 0 par le numéro du champs -1 et d'y mettre ce que tu veux du genre :
'oPS.Fields(1) = oProdRS.Fields(1).value
End If
'Maintenant on va prendre toutes les infos de ton fichier excel pour les mettre dans la table resultat_controle (seulement si ton fichier excel a la même structure que ta table, cad nom des champs en 1ère ligne, et les même champs avec les mêmes noms)
For j = 0 To oProdRS.Fields.Count -1
oRS.Fields(j) = oProdRS.Fields(j).Value
Next j
oRS.Update
oProdRS.MoveNext
Loop
oProdRS.Close
'Fermeture de la connection au classeur Excel
Cn.Close
Fichier = Dir
Loop
oConn.Close
Set oRS = Nothing
'Fermeture de la connection Access
Set oConn = Nothing
End Sub |
Partager