Editer le nom de son fichier excel et du dossier cible

**Antisthene** · 11/03/2013, 20h58

Bonsoir à tous,

Je souhaiterais utiliser les valeurs de 2 InputBox ( 2 dates ) et la valeur d'un champ de mon recordset pour personnaliser le nom du dossier ainsi que le nom de mon fichier excel en sortie de ma boucle.

Un membre de ce forum m'avait aidé pour paramétré le nom de mon fichier excel avec le champ de mon recordset, mais j'aimerais y ajouter mes valeurs des InputBox.

J'ai donc essayé d'utiliser les valeurs des inputbox en tant que macro-variables sur le même modèle mais ça bloque. Il doit y avoir un problème de format vu le message d'erreur qui s'affiche.
L'autre point noir c'est qu'il ne trouve pas le chemin ou sauvegarder mon classeur, ce qui semble assez logique puisqu'il n'existe pas encore.

Savez-vous comment je dois m'y prendre.
J'ai vu des exemples de code mais ca récupéré des données dans un formulaire avec une option caption. J'y comprends pas grand chose

Voici le code qu'un membre de ce forum a réalisé.

Merci d'avance pour votre aide

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
86
87
88
89
90
Sub Commande12_Click()
 
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim rec0, rec1, rec2 As Recordset
    Dim I As Long, J As Long
    Dim Rep As String
    Dim DateMax As Date
    Dim Pas As Double
 
    'Definir le Pas
 
    Pas = -7
 
        Do
    Rep = InputBox("Saisir Date max periode observée ?")
Loop While (Not IsDate(Rep))
DateMax = CDate(Rep)
DateMin = DateAdd("d", Pas, DateMax)
 
MsgBox DateMin
 
 'Date_min = InputBox("Selectionner la date de JC de debut", "DATE DEBUT", Date)
 'Date_max = InputBox("Entrez la date de début voulu" & vbCrLf & "format (JJ/MM/YYYY)")
 'Date_max = InputBox("Selectionner la date de JC de fin", "DATE FIN", Date)
 'Date_min = DateAdd("d", -7, Date_max)
 
    Set rec1 = CurrentDb.OpenRecordset("select distinct Nom from Table1 where [Date JC] between #" & Format(DateMin, "mm/dd/yyyy") & "# and #" & Format(DateMax, "mm/dd/yyyy") & "#;", dbOpenSnapshot)
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
 
      Repert = "C:\Users\gk\Documents\TEST\" & "Copie_de_TB.xls"
      MsgBox Repert
 
    xlApp.Workbooks.Open Repert, 0
 
    MsgBox "Testons"
 
    While Not rec1.EOF
 
    ' Création du classeur
        Set xlBook = xlApp.Workbooks.Add
        Set xlSheet = xlBook.Worksheets.Add
 
         Set rec2 = CurrentDb.OpenRecordset("select * from Table1 where Nom ='" _
                                                & rec1.Fields("Nom") & "' and [Date JC]  between #" & Format(DateMin, "mm/dd/yyyy") & "# and #" & Format(DateMax, "mm/dd/yyyy") & "#;", dbOpenSnapshot)
 
   ' Chargement des enregistrements
        ' Entête
        I = 1
        For J = 0 To rec2.Fields.Count - 1
            xlSheet.Cells(I, J + 1) = rec2.Fields(J).Name
        Next J
 
        I = 2
        While Not rec2.EOF
        ' Détail
            For J = 0 To rec2.Fields.Count - 1
                If rec2.Fields(J).Type = dbText Then
                    xlSheet.Cells(I, J + 1) = "'" & rec2.Fields(J)
                Else
                    xlSheet.Cells(I, J + 1) = rec2.Fields(J)
                End If
            Next J
            I = I + 1
            rec2.MoveNext
        Wend
    ' Sauvegarde de la feuille Excel
 
C ICI QUE JE VEUX INTEGRER MES INPUTBOX NOTAMMENT
 
xlBook.SaveAs "C:\Users\gk\Documents\TEST\ " & rec1.Fields("Nom") & " \" & DateMin" & "-" & DateMax & " \ " & rec1.Fields("Nom") & "_" & DateMin & "-" & DateMax & ".xls"
 
 
        rec1.MoveNext
    Wend
 
    xlApp.Quit
    rec1.Close
    rec2.Close
    Set rec1 = Nothing
    Set rec2 = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
 
    MsgBox "fin de l'extraction"
 
End Sub

**tee_grandbois** · 12/03/2013, 00h22

Bonsoir Antisthene,
3 raisons qui font que ton code ne fonctionne pas
1) tu as trouvé la première : si le ou les répertoires n'existent pas, il faut les créer avant (faire un test d'existence avec Dir, ensuite Mkdir pour le(s) créer).
2) le nom d'un répertoire ne doit pas contenir de '/', comme les variables DateMax et DateMin en contiennent, il faut les supprimer avec l'instruction Format
3) il y avait également une erreur de syntaxe : une " de trop à l'instruction 73, juste après Datemin.

Autre remarque : pour quelle raison ouvres-tu le fichier C:\Users\gk\Documents\TEST\" & "Copie_de_TB.xls alors que tu ne l'utilises pas ?
Voici ton code corrigé :

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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Sub Commande12_Click()
 
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim rec0, rec1, rec2 As Recordset
    Dim I As Long, J As Long
    Dim Rep As String
    Dim DateMax As Date
    Dim Pas As Double
 
    'Definir le Pas
 
    Pas = -7
 
    Do
        Rep = InputBox("Saisir Date max periode observée ?")
    Loop While (Not IsDate(Rep))
 
    DateMax = CDate(Rep)
    DateMin = DateAdd("d", Pas, DateMax)
 
MsgBox DateMin
 
 'Date_min = InputBox("Selectionner la date de JC de debut", "DATE DEBUT", Date)
 'Date_max = InputBox("Entrez la date de début voulu" & vbCrLf & "format (JJ/MM/YYYY)")
 'Date_max = InputBox("Selectionner la date de JC de fin", "DATE FIN", Date)
 'Date_min = DateAdd("d", -7, Date_max)
 
    Set rec1 = CurrentDb.OpenRecordset("select distinct Nom from Table1 where [Date JC] between #" & Format(DateMin, "mm/dd/yyyy") & "# and #" & Format(DateMax, "mm/dd/yyyy") & "#;", dbOpenSnapshot)
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
 
'      Repert = "C:\Users\gk\Documents\TEST\" & "Copie_de_TB.xls"
'      MsgBox Repert
 
'    xlApp.Workbooks.Open Repert, 0
 
'    MsgBox "Testons"
 
    While Not rec1.EOF
 
    ' Création du classeur
        Set xlBook = xlApp.Workbooks.Add
        Set xlSheet = xlBook.Worksheets.Add
 
         Set rec2 = CurrentDb.OpenRecordset("select * from Table1 where Nom ='" _
                                                & rec1.Fields("Nom") & "' and [Date JC]  between #" & Format(DateMin, "mm/dd/yyyy") & "# and #" & Format(DateMax, "mm/dd/yyyy") & "#;", dbOpenSnapshot)
 
   ' Chargement des enregistrements
        ' Entête
        I = 1
        For J = 0 To rec2.Fields.Count - 1
            xlSheet.Cells(I, J + 1) = rec2.Fields(J).Name
        Next J
 
        I = 2
        While Not rec2.EOF
        ' Détail
            For J = 0 To rec2.Fields.Count - 1
                If rec2.Fields(J).Type = dbText Then
                    xlSheet.Cells(I, J + 1) = "'" & rec2.Fields(J)
                Else
                    If rec2.Fields(J).Type = dbDate Then
                        xlSheet.Cells(I, J + 1) = Format(rec2.Fields(J), "dd/mm/yyyy")
                    Else
                        xlSheet.Cells(I, J + 1) = rec2.Fields(J)
                    End If
                End If
            Next J
            I = I + 1
            rec2.MoveNext
        Wend
    ' Contrôle de l'existence de chaque répertoire (en général, pour chaque \ trouvé sauf celui de la racine : C:\)
    ' Ici, on le fait après \TEST
        If Dir("C:\Users\gk\Documents\TEST\" & rec1.Fields("Nom"), vbDirectory) = "" Then
            MkDir "C:\Users\gk\Documents\TEST\" & rec1.Fields("Nom")
        End If
 
        If Dir("C:\Users\gk\Documents\TEST\" & rec1.Fields("Nom") & "\" & Format(DateMin, "YYYYMMDD") & "-" & Format(DateMax, "YYYYMMDD"), vbDirectory) = "" Then
            MkDir "C:\Users\gk\Documents\TEST\" & rec1.Fields("Nom") & "\" & Format(DateMin, "YYYYMMDD") & "-" & Format(DateMax, "YYYYMMDD")
        End If
    ' Sauvegarde de la feuille Excel
        xlBook.SaveAs "C:\Users\gk\Documents\TEST\" & rec1.Fields("Nom") & "\" & Format(DateMin, "YYYYMMDD") & "-" & Format(DateMax, "YYYYMMDD") & "\" & rec1.Fields("Nom") & "_" & Format(DateMin, "YYYYMMDD") & "-" & Format(DateMax, "YYYYMMDD") & ".xls"
 
        rec1.MoveNext
    Wend
 
    xlApp.Quit
    rec1.Close
    rec2.Close
    Set rec1 = Nothing
    Set rec2 = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
 
    MsgBox "fin de l'extraction"
 
End Sub

**Antisthene** · 12/03/2013, 09h26

bonjour tee_grandboise

je m excuse je t écris àvéc mon téléphone les serveur du boulot sont encore en maintenance et vu la neige ça risque de durer les personnes ont dû mal à arriver!

je nr peux pas tester le code que tu as modifié mais t'es remarques sont si logiques.
pour ce qui du bout de code en trop je m'en servais pour test je ne l utilise pas.

merci je te dis si ça marchez des que possible

**Antisthene** · 12/03/2013, 18h17

J'ai finalement pu tester ce fameux "mkDir".
C'est juste parfait, ça va me changer la vie.

Grand merci pour ton expertise salvatrice.

Bonne fin de journée.

Editer le nom de son fichier excel et du dossier cible [AC-2003]

VBA Access

Discussions similaires

Partager

Partager