Bonjour à tous,
J’utilise actuellement une connexion adodb pour renseigner un fichier base.xlsx.
Cette méthode fonctionne mais j’ai quelque problème de format dû au fichier Excel.
Edit du 24/06 : Mon idée première n'était pas bonne. Sur les conseils de Jam et de Chris je garde une base au format XLSX.
Voir mon nouveau message du 24/06 pour reprise du fil. Merci.
C’est pour cette raison que j’aimerais utiliser une base au format txt.
J’ai donc essayé de modifier mon code pour réaliser une connexion sur le txt au lieu du xlsx.
La connexion semble s’effectuer correctement mais les recherché bloquent.
Pouvez-vous m’aider à modifier ce code SVP ?
Merci
J’utilise actuellement une connexion adodb pour renseigner un fichier base.xlsx.
Cette méthode fonctionne mais j’ai quelque problème de format dû au fichier Excel.
Edit du 24/06 : Mon idée première n'était pas bonne. Sur les conseils de Jam et de Chris je garde une base au format XLSX.
Voir mon nouveau message du 24/06 pour reprise du fil. Merci.
C’est pour cette raison que j’aimerais utiliser une base au format txt.
J’ai donc essayé de modifier mon code pour réaliser une connexion sur le txt au lieu du xlsx.
Code:
Sub Sauvegarder_en_TXT()
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim Fichier As String, NomFeuille As String, Direction As String
Dim VSearch As String, i As Integer
' Chemin d'accès de la base
Direction = ThisWorkbook.Path
Fichier = "base.txt"
' Créer la connexion
Set Cn = New ADODB.Connection
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & Direction & ";Extended Properties='text;HDR=NO;FMT=Delimited'"
.Open
End With
Set Cd = New ADODB.Command
Cd.ActiveConnection = Cn
' Ouvrir 1000 lignes d'enegistrement
Cd.CommandText = "SELECT * FROM [" & Fichier & "]"
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic
'Boucler sur plusieurs lignes
DernLigne = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
For L = 11 To DernLigne
' Chercher la valeur dans la BdD
Rst.Find "F1 = '" & Cells(L, 1) & "'", , adSearchForward, 1
' Si on se retrouve à la fin des enregistrement
' On en créé un nouveau
If Rst.EOF = True Then Rst.AddNew
' On rempli la ligne d'enregistrement avec les valeurs
For i = 0 To 19 ' Mettre ici le nombre de champs -1
Rst(i).Value = Sheets("Feuil1").Cells(L, 1 + i)
Next i
Next L
' Metre à jour la ligne d'enregistrement
Rst.Update
' Fermer la connexion
Cn.Close
' Effacer les variables objet
Set Cn = Nothing
Set Cd = Nothing
Set Rst = Nothing
End Sub
La connexion semble s’effectuer correctement mais les recherché bloquent.
Pouvez-vous m’aider à modifier ce code SVP ?
Merci
Pièces jointes
Dernière édition: