Généré un fichier txt et l'enregistrer dans un répertoire choisi

**DSI00958** · 20/06/2018, 14h27

Bonjour,
Je suis actuellement en train de réaliser une macro excel. Je travaille sur plusieurs feuilles excel, et une possède des données que je souhaite retranscrire en sql. J'arrive bien à généré le script qui se met dans une autre feuille du classeur. Cependant ce n'est pas ce que je veux, j'ai crée une feuille PARAMETRES dans laquelle l'utilisateur peut donner le nom qu'il souhaite au fichier.txt et aussi le répertoire qu'il souhaite. Et ensuite quand je clique sur le bouton pour générer le script, le fichier doit s'enregistrer dans le dossier souhaité et avec le bon nom. Mais ça ne fonctionne pas ! Merci d'avance !

**Jean-Philippe André** · 20/06/2018, 14h41

Bonjour,

et quel est ton code actuel stp ?

**DSI00958** · 20/06/2018, 14h52

Le voilà :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Sub GenereSQL()
 
On Error GoTo X_ERR
 
Dim SQLDEB As String
Dim SQL_VAL As String
Dim CptChamp As Integer
Dim SQL_LIGNE As String
Dim SQL_TMP As String
 
'''On efface les données SQL Précédentes
 Sheets("SQL").Activate
 Columns("A:A").Select
 Selection.ClearContents
 
Sheets("TABLE").Activate
''Initialise la ligne de démarrage dans la table
CptChamp = 2
 
'Création du début du sql
SQLDEB = "INSERT INTO " & Cells(1, 1).Value & " ("
Do While Cells(CptChamp, 1) <> ""
 
  If Range("I" & CptChamp) = "" Then
   SQLDEB = SQLDEB & Cells(CptChamp, 1).Value & IIf(Cells(CptChamp + 1, 1) = "", "", ",")
  End If
 CptChamp = CptChamp + 1
Loop
SQLDEB = IIf(Right(SQLDEB, 1) = ",", Left(SQLDEB, Len(SQLDEB) - 1), SQLDEB)
SQLDEB = SQLDEB & ") VALUES ("
 
 
''Balaye toutes les lignes de la feuille données
For i = 2 To 10000
SQL_LIGNE = SQLDEB
'''Génération de la partie values de la ligne de SQL
 CptChamp = 2
        Do While Cells(CptChamp, 1) <> "" 'continue pour balayer tous les champs de la table  et teste la présence du dernier champ de la table
           If Range("I" & CptChamp) = "" Then ''La colonne est utilisée dans le SQL
             If Range("D" & CptChamp) <> "" Then SQL_TMP = SQL_TMP & IIf(Range("D" & CptChamp) = "$$", i, Range("D" & CptChamp)) & " "
             If Range("E" & CptChamp) <> "" Then SQL_TMP = SQL_TMP & ChercheValeur("DONNEES", Range("E" & CptChamp) & i, Range("B" & CptChamp)) & " "
             If Range("F" & CptChamp) <> "" Then SQL_TMP = SQL_TMP & Range("F" & CptChamp) & " "
             If Range("G" & CptChamp) <> "" Then SQL_TMP = SQL_TMP & ChercheValeur("DONNEES", Range("G" & CptChamp) & i, Range("B" & CptChamp))
             If Left(Range("B" & CptChamp), 7) = "VARCHAR" Then
              SQL_TMP = Range("C" & CptChamp) & Trim(SQL_TMP) & Range("H" & CptChamp)
            End If
 
 
            If SQL_VAL <> "" Then SQL_VAL = SQL_VAL & ", "
 
 
           SQL_VAL = SQL_VAL & SQL_TMP
           SQL_TMP = ""
           End If
            CptChamp = CptChamp + 1
       Loop
 
 ''On vérifie que sqlval ne se termine pas par une virgule
 If Right(sqlval, 1) = "," Then
 'MsgBox "a" & SQL_VAL
  SQL_VAL = Left(SQL_VAL, Len(SQL_VAL) - 1)
 'MsgBox "b" & SQL_VAL
 End If
 
 SQL_LIGNE = SQL_LIGNE & SQL_VAL & ");" & vbCrLf
 'MsgBox SQL_LIGNE
 Sheets("SQL").Cells(i, 1) = SQL_LIGNE
 SQL_VAL = ""
 
 If Sheets("DONNEES").Range("A" & i + 1).Value = "" Then
  MsgBox "SQL Généré" & vbCrLf & i & " lignes", vbOKOnly + vbInformation, "Fin de traitement"
  Exit Sub
 End If
Next i
 
SORTIR:
  Exit Sub
 
X_ERR:
  MsgBox Err.Number & " " & Err.Description
  ChangeFileOpenDirectory = Feuil8.Range("B3").Value
  SaveAs Filename:=Feuil8.Range("B2").Value & ".txt"
  Resume SORTIR
 
End Sub

**Jean-Philippe André** · 20/06/2018, 15h02

Bonjour,

comme bon nombre de développeurs, tu souffres du syndrome du On Error GoTo

Si tu fais un débogage pas à pas, constates-tu que la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

SaveAs Filename:=Feuil8.Range("B2").Value & ".txt"

est vraiment exécutée ?

Je te mets trois billes et un calot que si aucune erreur n'a lieu dans ton execution, elle n'est jamais lue...

Premiere étape, essaie de virer le On Error GoTo (inutile et source de ton problème ici) ainsi que les Exit Sub.

Une fois cette étape faite, reposte nous ton code

**DSI00958** · 20/06/2018, 15h13

Non, elle n'est pas exécuté, j'ai donc essayé comme vous me l'avez conseillé mais cela me génère des lignes à l'infinie.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
72
73
74
75
76
77
Sub GenereSQL()
 
 
 
Dim SQLDEB As String
Dim SQL_VAL As String
Dim CptChamp As Integer
Dim SQL_LIGNE As String
Dim SQL_TMP As String
 
'''On efface les données SQL Précédentes
 Sheets("SQL").Activate
 Columns("A:A").Select
 Selection.ClearContents
 
Sheets("TABLE").Activate
''Initialise la ligne de démarrage dans la table
CptChamp = 2
 
'Création du début du sql
SQLDEB = "INSERT INTO " & Cells(1, 1).Value & " ("
Do While Cells(CptChamp, 1) <> ""
 
  If Range("I" & CptChamp) = "" Then
   SQLDEB = SQLDEB & Cells(CptChamp, 1).Value & IIf(Cells(CptChamp + 1, 1) = "", "", ",")
  End If
 CptChamp = CptChamp + 1
Loop
SQLDEB = IIf(Right(SQLDEB, 1) = ",", Left(SQLDEB, Len(SQLDEB) - 1), SQLDEB)
SQLDEB = SQLDEB & ") VALUES ("
 
 
''Balaye toutes les lignes de la feuille données
For i = 2 To 10000
SQL_LIGNE = SQLDEB
'''Génération de la partie values de la ligne de SQL
 CptChamp = 2
        Do While Cells(CptChamp, 1) <> "" 'continue pour balayer tous les champs de la table  et teste la présence du dernier champ de la table
           If Range("I" & CptChamp) = "" Then ''La colonne est utilisée dans le SQL
             If Range("D" & CptChamp) <> "" Then SQL_TMP = SQL_TMP & IIf(Range("D" & CptChamp) = "$$", i, Range("D" & CptChamp)) & " "
             If Range("E" & CptChamp) <> "" Then SQL_TMP = SQL_TMP & ChercheValeur("DONNEES", Range("E" & CptChamp) & i, Range("B" & CptChamp)) & " "
             If Range("F" & CptChamp) <> "" Then SQL_TMP = SQL_TMP & Range("F" & CptChamp) & " "
             If Range("G" & CptChamp) <> "" Then SQL_TMP = SQL_TMP & ChercheValeur("DONNEES", Range("G" & CptChamp) & i, Range("B" & CptChamp))
             If Left(Range("B" & CptChamp), 7) = "VARCHAR" Then
              SQL_TMP = Range("C" & CptChamp) & Trim(SQL_TMP) & Range("H" & CptChamp)
            End If
 
 
            If SQL_VAL <> "" Then SQL_VAL = SQL_VAL & ", "
 
 
           SQL_VAL = SQL_VAL & SQL_TMP
           SQL_TMP = ""
           End If
            CptChamp = CptChamp + 1
       Loop
 
 ''On vérifie que sqlval ne se termine pas par une virgule
 If Right(sqlval, 1) = "," Then
 'MsgBox "a" & SQL_VAL
  SQL_VAL = Left(SQL_VAL, Len(SQL_VAL) - 1)
 'MsgBox "b" & SQL_VAL
 End If
 
 SQL_LIGNE = SQL_LIGNE & SQL_VAL & ");" & vbCrLf
 'MsgBox SQL_LIGNE
 Sheets("SQL").Cells(i, 1) = SQL_LIGNE
 SQL_VAL = ""
 
 If Sheets("DONNEES").Range("A" & i + 1).Value = "" Then
  MsgBox "SQL Généré" & vbCrLf & i & " lignes", vbOKOnly + vbInformation, "Fin de traitement"
 End If
Next i
  ChangeFileOpenDirectory = Feuil8.Range("B3").Value
  SaveAs Filename:=Feuil8.Range("B2").Value & ".txt"
 
End Sub

**Jean-Philippe André** · 20/06/2018, 15h29

Lorsque l'on commence à développer, il n'est pas pertinent de partir sur une gestion d'erreur immédiate, car cela t'empêche de comprendre en quoi le code est mal rédigé. L'utilisation du On Error Goto reste la dernière étape, si tu veux mettre par exemple des traces dans des logs.

Concernant le très grand nombre de lignes, Est-ce normal d'avoir une boucle comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
''Balaye toutes les lignes de la feuille données
For i = 2 To 10000

elle meme imbriquant un boucle Do While.

**DSI00958** · 20/06/2018, 15h35

C'est que je ne sais pas combien de lignes vont être converti, donc je balaye toutes les lignes de la feuille de données. Il y aune autre manière de procéder ?

**Jean-Philippe André** · 20/06/2018, 16h24

Oui,

tu peux limiter la plage de lecture avec par exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For i = 2 To Range("A65536").End(xlUp).Row

qui pointe sur la derniere ligne utilisée dans la colonne A (utilise une autre colonne si la colonne A en question n'est pas toujours remplie), en ajoutant probablement la feuille dans laquelle tu souhaites lire l'information

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For i = 2 To Worksheets("MaFeuille").Range("A65536").End(xlUp).Row

**DSI00958** · 21/06/2018, 08h44

Bonjour,
Mais mon fichier .txt ne s'enregistre toujours pas au bon endroit avec le bon nom..

**Jean-Philippe André** · 21/06/2018, 15h49

Salut,

d'où sors-tu ce code ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
ChangeFileOpenDirectory = Feuil8.Range("B3").Value
  SaveAs Filename:=Feuil8.Range("B2").Value & ".txt"

Regarde la syntaxe https://www.developpez.net/forums/d3...-thode-saveas/

**DSI00958** · 21/06/2018, 16h00

J'ai fait quelques tests, qui n'ont pas été concluant mais j'ai supprimé cette partie du code. Il ne faut pas y faire attention.

Généré un fichier txt et l'enregistrer dans un répertoire choisi

Macros et VBA Excel

Discussions similaires

Partager

Partager