Je crée en ce moment un prg qui me permet par un simple clic sur un treeview d'insèrer des données d'un fichier vers une base access.
J'ai toutes les fonctions possibles sur cette base (premier dernier suivant précédent nouveau supprimer) etc etc
sauf ...la mise à jour d"un champ ....
En fait, j'arrive pas à enregistrer les modifications effecuées sur le champ.Il me crée un nouveau record avec les données modifiées .
Je trouve pas la solution, quelqu'un à une idée ?
Merci d'avance
Thyphon
A voir également:
Access mise à jour table à partir d'une autre table
Access movelast - Meilleures réponses
Access vba requête mise à jour - Meilleures réponses
Je serai toi, pour tout ce qui est de : Nouveau, modifier, supprimer, j'utiliserai des requêtes SQL que tu exécute via ton recordset et ta connection à la base, plus rapide à l'exécution...
Exemple de 3 requêtes SQL issue de ma source:
Requêtes Ajout :
' Préparation de la requête
Sql = "INSERT INTO TaTable(Champ1,Champ2,Champ3,Champ4)" & _
"Values('" & Txt_détails(1).Text & "','" & Txt_détails(2).Text & "','" & Txt_détails(3).Text & "', '" & Txt_détails(4).Text & "')"
Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
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 DicIcones As Scripting.Dictionary
Dim db As Database
Dim rs As Recordset
Dim sql As String
Public DocE As Object
NodeX.Expanded = True
'pointeur de la souris
Me.MousePointer = 0
NodeX.Selected = True
End Sub
Sub FindFilesAPI(ByVal sPath As String, ByRef pNode As Node)
On Error GoTo Erreurs
Dim DirName As String ' Nom du sous-dossiers
Dim hSearch As Long ' Handle de recherche
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim nNombreDir As Integer
Dim tempNode As Node
Dim tempNode2 As Node
Dim lngNombreDeSousFichier As Long
Dim objFSO As Scripting.FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Met le bon format du chemin
If Right(sPath, 1) <> "" Then
sPath = sPath & ""
End If
' Recherche les sous-dossiers
Cont = True
hSearch = FindFirstFile(sPath & "*", WFD)
If TreeViewCtl.SelectedItem.children < 1 Then
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
Set tempNode2 = TreeViewCtl.SelectedItem
DirName = StripNulls(WFD.cFileName)
If objFSO.FolderExists(sPath & DirName & "") And (DirName <> ".") And (DirName <> "..") Then
If objFSO.GetFolder(sPath & DirName & "").Attributes <> 22 Then
lngNombreDeSousFichier = objFSO.GetFolder(sPath & DirName & "").Files.Count
If lngNombreDeSousFichier <> 0 Then
Set tempNode = TreeViewCtl.Nodes.Add(, , sPath & DirName & "", DirName & " ( nombres de fichiers : " & lngNombreDeSousFichier & ")", 1, 2)
Else
Set tempNode = TreeViewCtl.Nodes.Add(, , sPath & DirName & "", DirName, 1, 2)
End If
'objFSO.Drives.Count
nNombreDir = objFSO.GetFolder(sPath & DirName & "").SubFolders.Count
If nNombreDir <> 0 Then
Set tempNode2 = TreeViewCtl.Nodes.Add(, , DirName & nNombreDir, , 1, 2)
Set tempNode2.Parent = tempNode
End If
Set tempNode.Parent = pNode
End If
'End If
End If
Cont = FindNextFile(hSearch, WFD) 'Obtient le sous-dossier suivant.
Loop
Cont = FindClose(hSearch)
pNode.Sorted = True
End If
End If
Exit Sub
Erreurs:
MsgBox "Voici le chemin spécifié : " & sPath
End Sub
Private Sub BuildFileTree(p_strDestination As String)
On Error GoTo Erreurs
'déclaration d'un objet Node
Dim NodeX As Node
Dim NodeParent As Node
Dim strArray() As String
Dim hSearch As Long
Dim Cont As Long
Dim FileName As String
Dim strExtension As String
Dim WFD As WIN32_FIND_DATA
Dim lngIcone As Long
Dim objFSO As Scripting.FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
Me.MousePointer = 11
'Met le bon format du chemin
If Right(p_strDestination, 1) <> "" Then p_strDestination = p_strDestination & ""
strArray = Split(p_strDestination, "")
'Préparation du view tree
TreeViewFile.Nodes.Clear
hSearch = FindFirstFile(p_strDestination & "*", WFD)
Set NodeParent = TreeViewFile.Nodes.Add(, , "root", strArray(UBound(strArray) - 1), 21, 15)
NodeParent.Expanded = True
NodeParent.Selected = True
Cont = 1
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
FileName = StripNulls(WFD.cFileName)
If objFSO.FileExists(p_strDestination & FileName) Then
strExtension = LCase(objFSO.GetExtensionName(p_strDestination & FileName))
If DicIcones.Exists(strExtension) Then
lngIcone = (DicIcones.Item(strExtension))
Else
lngIcone = 9
End If
Set NodeX = TreeViewFile.Nodes.Add(, , p_strDestination & FileName, FileName, lngIcone, lngIcone)
Set NodeX.Parent = NodeParent
End If
Cont = FindNextFile(hSearch, WFD) 'Obtient le sous-dossier suivant.
Loop
End If
Cont = FindClose(hSearch)
Me.MousePointer = 0
TreeViewFile.SelectedItem.Sorted = True
Exit Sub
Erreurs:
MsgBox "Voici le chemin spécifié : " & p_strDestination
End Sub
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = Left$(OriginalStr, 1) & (Mid$(OriginalStr, 2))
If Err.Number = 35602 Then Exit Function
End Function
Private Sub Label1_Click()
CNouveau_Click
Text1.Text = TreeViewFile.SelectedItem
Set DocE = GetObject(TreeViewFile.SelectedItem.Key)
'DocE.sheets("Description").Select
Text2.Text = (DocE.worksheets(1).range("AK8"))
Text5.Text = (DocE.worksheets(1).range("AO12"))
Text3.Text = (DocE.worksheets(1).range("C8"))
Text4.Text = (DocE.worksheets(1).range("Y8"))
Text6.Text = (DocE.worksheets(1).range("E16"))
Text8.Text = (DocE.worksheets(1).range("E19"))
Text10.Text = (DocE.worksheets(1).range("E22"))
Text12.Text = (DocE.worksheets(1).range("E25"))
Text14.Text = (DocE.worksheets(1).range("E28"))
Text16.Text = (DocE.worksheets(1).range("E31"))
Text18.Text = (DocE.worksheets(1).range("E34"))
Text20.Text = (DocE.worksheets(1).range("E37"))
Text22.Text = (DocE.worksheets(1).range("E40"))
Text24.Text = (DocE.worksheets(1).range("E43"))
Text28.Text = (DocE.worksheets(1).range("E46"))
Text30.Text = (DocE.worksheets(1).range("E49"))
If Text6.Text = "" Then
Text6.Text = rs.Fields("Description_1").DefaultValue
End If
If Text8.Text = "" Then
Text8.Text = rs.Fields("Description_2").Value
End If
If Text10.Text = "" Then
Text10.Text = rs.Fields("Description_3").DefaultValue
End If
If Text12.Text = "" Then
Text12.Text = rs.Fields("Description_4").DefaultValue
End If
If Text14.Text = "" Then
Text14.Text = rs.Fields("Description_5").DefaultValue
End If
If Text16.Text = "" Then
Text16.Text = rs.Fields("Description_6").DefaultValue
End If
If Text18.Text = "" Then
Text18.Text = rs.Fields("Description_7").DefaultValue
End If
If Text20.Text = "" Then
Text20.Text = rs.Fields("Description_8").DefaultValue
End If
If Text22.Text = "" Then
Text22.Text = rs.Fields("Description_9").DefaultValue
End If
If Text24.Text = "" Then
Text24.Text = rs.Fields("Description_10").DefaultValue
End If
If Text28.Text = "" Then
Text28.Text = rs.Fields("Description_10").DefaultValue
End If
If Text30.Text = "" Then
Text30.Text = rs.Fields("Description_10").DefaultValue
End If
If Text7.Text = "" Then
Text7.Text = rs.Fields("Defaut_1").Value
End If
If Text9.Text = "" Then
Text9.Text = rs.Fields("Defaut_2").Value
End If
If Text11.Text = "" Then
Text11.Text = rs.Fields("Defaut_3").DefaultValue
End If
If Text13.Text = "" Then
Text13.Text = rs.Fields("Defaut_4").DefaultValue
End If
If Text15.Text = "" Then
Text15.Text = rs.Fields("Defaut_5").DefaultValue
End If
If Text17.Text = "" Then
Text17.Text = rs.Fields("Defaut_6").DefaultValue
End If
If Text19.Text = "" Then
Text19.Text = rs.Fields("Defaut_7").DefaultValue
End If
If Text21.Text = "" Then
Text21.Text = rs.Fields("Defaut_8").DefaultValue
End If
If Text23.Text = "" Then
Text23.Text = rs.Fields("Defaut_9").DefaultValue
End If
If Text25.Text = "" Then
Text25.Text = rs.Fields("Defaut_10").DefaultValue
End If
If Text28.Text = "" Then
Text28.Text = rs.Fields("Defaut_10").DefaultValue
End If
If Text29.Text = "" Then
Text29.Text = rs.Fields("Defaut_10").DefaultValue
End If
If Text30.Text = "" Then
Text30.Text = rs.Fields("Defaut_10").DefaultValue
End If
If Text31.Text = "" Then
Text31.Text = rs.Fields("Defaut_10").DefaultValue
End If
End Sub
Private Sub MAJ_Click()
rs.OpenRecordset
End Sub
Private Sub OuvDB_Click()
Set db = OpenDatabase(App.Path & "\RMC.mdb") 'Ouvre la base de données
Set rs = db.OpenRecordset("select * from RMC", dbOpenDynaset)
rs.MoveLast
'pointeur de la souris
Me.MousePointer = 0
End Sub
Private Sub TreeViewFile_Click()
Dim NodeX As Node
Set NodeX = TreeViewFile.SelectedItem
If Not (TreeViewFile.SelectedItem.Key = "root") Then
OLE1.CreateLink (TreeViewFile.SelectedItem.Key)
Else
If NodeX.Expanded = False Then
NodeX.Expanded = False
NodeX.Selected = False
Else
NodeX.Expanded = True
NodeX.Selected = True
End If
End If
End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
<li>PublicSub MODIFIER(rs As ADODB.Recordset, cn As ADODB.Connection, sql AsString, Frm As Form, ParamArray NomChamp() AsVariant)
</li><li> Dim i, compt AsInteger
</li><li> rs.Open sql, cn, 1, 2
</li><li> i = rs.Fields.Count
</li><li> For compt = 0 To i - 1
</li><li> rs.Fields(NomChamp(compt)) = Frm(NomChamp(compt)).Text
</li><li> Next compt
</li><li> rs.Update
</li><li> rs.Close
</li><li>EndSub
Je vais voir ce que cela donne </li>
Boudiout...C'est toute la source que tu as posté là...
Pour faire la modife d'un enregistrement dans ta base, il te faut avant te positionner dessus...Une fois que tu es positionné dessus, tu utilises : Rs.update
Est-ce dans ta base tu as un clé primaire de définit ? Si, oui, utilises là pour te positionner sur ton enregistrement(en la recherchant dans la base soit pas une requête SQL, soit par l'instruction Find) et ensuite tu ton ton update(pas de addnew)...
Boudiout...C'est toute la source que tu as posté là...
Pour faire la modife d'un enregistrement dans ta base, il te faut avant te positionner dessus...Une fois que tu es positionné dessus, tu utilises : Rs.update
A+
Exploreur
Et ben non, c'est une partie du code située sur une console....en fait les fichiers sont de type excel, visu en OLE etc etc mais çà c'est la partie "gestion" du prg....je me rends compte que je crée un monstre lol...
Merci à toi pour ton soutient Explorer...dès que j'ai la bonne solution je la reposte ici et je mettrais bien le prg en source après
Oui j'ai une clé primaire (j'entends encore les cris de l'instructeur disant...on ne crée pas de base access sans clé primaire !!)
mwais....sur une base simple je la mets...sinon.....
Mais merci encore pour le soutient...là je vais m'aérer les neuronnes puis je m'y remettrais....@pluche
Et bien je me suis replongé dans mes notes d'autrefois et oui, je pense que je vais modifier le tout et opter pour le SQL.
Mon problème....je ne fais jamais de plan de projet....mais là, j'ai restructuré le tout cette nuit et je vais épurer ce code un peu
touffu...encore merci pour tout et bonne continuation
Je voulais te dire une dernier petit truc..du moins un "conseil" par rapport à ton code...Utilises plutôt des textbox indexés, c'est beaucoup plus pratique quand tu dois faire des boucles...