VBA erreur de compilation à l'import d'un Excel (avec conversion) vers Access

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

J'ai une macro permettant de convertir un nombre en date (dans 3 colonnes différentes, d'où la partie Fonction), d'ajouter une colonne et d'y renseigner le numéro de semaine de cette même date.
Le but étant de :
=> Cliquer sur le bouton de formulaire Access pour selection des fichiers devant subir ces conversions (les enregistrer sous Excel)
=> Importer les données dans ma table Access

L'erreur de compilation est ici :
Pièce jointe 618585
Comment lié les tous mes éléments ?

Mon code de conversion :

Code:

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
 
Sub TestAppli()
 
 
I = 2
While Cells(I, 1) <> "": I = I + 1: Wend
 
For l = 2 To I - 1
Cells(l, 3) = convertdat(Cells(l, 3))
Cells(l, 6) = convertdat(Cells(l, 6))
Cells(l, 7) = convertdat(Cells(l, 7))
Next
Columns("D:D").Insert Shift:=xlToRight
Cells(1, 4) = "Semaine"
For l = 2 To I - 1
Cells(l, 4) = DatePart("ww", Cells(l, 3), vbMonday, vbFirstFourDays)
Cells(l, 4).NumberFormat = "general"
Next
 
 
 
End Sub
 
 
Function convertdat(dat)
convertdat = DateSerial(Left(dat, 4), Mid(dat, 5, 2), Right(dat, 2))
End Function

Mon code d'importation :

Code:

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
 
Sub importJRN()
 
'Déclaration des variables
Dim chemins() As Variant
Dim chemin As Variant
Dim tableCible As String
Dim sqlCommand As String
 
'Gestion des erreurs
'On Error GoTo gestionErreurs
 
'Choix du fichier source
chemins() = selectionFichiers("Z:\xx2022")
'Arret des messages system
DoCmd.SetWarnings False
 
'Boucle d'importation
For Each chemin In chemins()
 
    'Vérification présence
    If DCount("*", "tblSuiviMAJ", "NomFichier = " & Chr(34) & Dir(chemin) & Chr(34)) < 1 Then
 
        'Nettoyage de la table temp avant import
        sqlCommand = "DELETE FROM tblTempJRN"
        DoCmd.RunSQL sqlCommand
 
Call TestAppli
 
        'Import du fichier
        DoCmd.TransferSpreadsheet acImport, , "tblTempJRN", chemin, 1
 
 
        'Transfert de la table temp vers table finale
        sqlCommand = "INSERT INTO tblJRN ( NomFichier, Fournisseur, [Type Prev], [Date MSG], [Référence], Libelle, [Date début], [Date fin], Qte, [Fixation = A], [Num Message], [Date déb sélection] ) " & _
                    "SELECT """ & Dir(chemin) & """, tblTempJRN.Fournisseur, tblTempJRN.[Type Prev], tblTempJRN.[Date MSG], tblTempJRN.[Référence], tblTempJRN.Libelle, tblTempJRN.[Date début], tblTempJRN.[Date fin], tblTempJRN.Qte, tblTempJRN.[Fixation = A], tblTempJRN.[Num Message], tblTempJRN.[Date déb sélection] " & _
                    "FROM tblTempJRN"
        DoCmd.RunSQL sqlCommand
 
 
        'Suivi des MAJ
        sqlCommand = "INSERT INTO tblSuiviMAJ (TableCible, NomFichier, DateAjout, NbLignes) " _
                   & "VALUES (""tblJRN"", """ & Dir(chemin) & """, NOW(), Dcount(""*"", ""tblTempJRN""))"
        DoCmd.RunSQL sqlCommand
 
 
 
    End If
 
Next
 
'Fin et nettoyage
DoCmd.SetWarnings True
MsgBox "Importation Terminée"
Exit Sub
 
'Gestion des erreurs
gestionErreurs:
    Debug.Print Err.Number
    Debug.Print Err.Description
    DoCmd.SetWarnings True
    MsgBox "Erreur lors de l'importation"
 
 
 
End Sub

Merci par avance,
LRN

Bonjour,

Si votre routine Sub TestAppli() est lancée depuis Access, Access ne sait pas que cette routine concerne une feuille Excel!

La première partie de votre code devrait donc ressembler à ceci (non testé):

Code:

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
Option Explicit
 
Sub TestAppli(sFichierXls As String)
    Dim XL As Object, i As Long, j As Long
    Set XL = CreateObject("Excel.Application")
    With XL
        .Visible = False
        .DisplayAlerts = False
        .Workbooks.Open sFichierXls
 
        With ActiveWorkbook.Worksheets(1)   '--- utilise la feuille 1
            i = 2
            While .Cells(i, 1) <> "": i = i + 1: Wend
 
            For j = 2 To i - 1
                .Cells(j, 3) = convertdat(.Cells(j, 3))
                .Cells(j, 6) = convertdat(.Cells(j, 6))
                .Cells(j, 7) = convertdat(.Cells(j, 7))
            Next
            .Columns("D:D").Insert Shift:=xlToRight
            .Cells(1, 4) = "Semaine"
            For j = 2 To i - 1
                .Cells(j, 4) = DatePart("ww", .Cells(j, 3), vbMonday, vbFirstFourDays)
                .Cells(j, 4).NumberFormat = "general"
            Next
        End With
        .ActiveWorkbook.Close (True)
        .Quit
    End With
    Set XL = Nothing
End Sub
 
 
Function convertdat(dat)
    convertdat = DateSerial(Left(dat, 4), Mid(dat, 5, 2), Right(dat, 2))
End Function

Et dans la 2e partie le Call devrait préciser le nom complet du fichier Excel (dossier + nom):

Code:

Call TestAppli(XlsNomComplet)

Utilisez systématiquement Option Explicit, même si cela peut sembler fastidieux au début.

Evitez d'utiliser un l (L minuscule) ou une I (i majuscule) comme variable, trop facilement confondus entre eux et avec 1.

Cordialement.

Bonjour Eric,

J'ai une erreur 424 sur la ligne du With :

Code:

1
2
3
4
5
6
7
 
 '.Workbooks.Open sFichierXls
        .Workbooks.Open "Z:\xx\2022\S18\PREVP0P 29042022.xlsx"
 
        'With ActiveWorkbook.Worksheets("PREVP0P")   '--- votre code pour utiliser la feuille 1, renommé avec le nom de mon onglet, sans succès
         With fenetreChoix.InitialFileName
            i = 2

Dans ma macro ImportJRN j'ai une fonction selectionFichiers :
J'aimerais utiliser le nom complet du fichier que j'ai sélectionné (pareil si j'ai sélectionné plusieurs fichiers) directement dans le code test Appli, mais je ne sais pas comment le rapporter, j'ai essayer avec le fenetreChoix.InitialFileName mentionné au dessus sans succès

Code:

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
 
Option Compare Database
 
Function selectionFichiers(sourceDefault As String)
'==========================================================
'Ouverture d'une fenetre qui permet de choisir des fichiers
'==========================================================
 
'Declaration des variables
Dim Ctr As Integer
Dim fenetreChoix As FileDialog
Dim arrayFichiers As Variant
 
 
'Initialisation de l'objet fenetre
Set fenetreChoix = Application.FileDialog(msoFileDialogFilePicker)
 
With fenetreChoix
    .InitialFileName = sourceDefault
    .AllowMultiSelect = True
    .Title = "Choisir un ou plusieurs fichiers."
    .Filters.Clear
    .Filters.Add "Excel", "*.xlsx"
    .Filters.Add "Excel 2003", "*.xls"
    .Filters.Add "Fichiers CSV", "*.csv"
    .Filters.Add "All Files", "*.*"
    If .Show = -1 Then
        ReDim arrayFichier(1 To .SelectedItems.Count)
        For Ctr = 1 To .SelectedItems.Count
            arrayFichier(Ctr) = .SelectedItems(Ctr)
        Next
 
    'on quitte toute la macro si la personne appuie sur Cancel
    Else
        End
 
    End If
 
End With
 
'Valeur de retour de la fonction
selectionFichiers = arrayFichier
 
End Function

Pour l'instant je suis bloquée

Merci par avance,
LRN

09/05/2022, 12h43
EricDgn

Bonjour,

Telle qu'écrite, votre fonction selectionFichiers ne donne aucun résultat: il ne contient aucune instruction indiquant selectionFichiers = ....
Par contre vous remplissez une variable tableau arrayFichiers (qu'il faudrait écrire arrayFichiers()) mais qui se trouve déclarée à l'intérieur de la fonction selectionFichiers. Cette variable disparait donc à la sortie de la fonction. Si vous voulez utiliser le contenu de cette variable à l'extérieur de cette fonction, il faut la déclarer à l'extérieur de cette fonction: il faut la placer au niveau du module pour qu'elle soit utilisable par les autres fonctions et routines.

Cordialement.

J'ai tenté pas mal de chose mais rien ne fonctionne.. malgré mes diverses lectures je n'ai pas toutes les logiques..

Sur le cheminement :
*macro d'import vers Acces
> appel de la fonction selectionFichiers
> appel de la macro TestAppli3 pour faire les conversions (fonction convertdat)
> import du fichier converti vers Access

Dans la macro selectionFichiers il y a deux variables arrayFichiers et arrayFichier, je ne comprends pas bien pourquoi. C'est bien c'est variables que je dois mettre à l'extérieur ? J'ai bien essayer de le mettre avant mes sub TestAppli3 ou sub importJRN mais ca ne résout pas l'erreur. Donc j'ai pensé à chemin, ou chemin() plutôt, idem..

du coup sur cette partie de code je sais que la ligne avec le xlsx fonctionne mais pourquoi celle de dessous en chemin () ne fonctionne pas ?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Set XL = CreateObject("Excel.Application") With XL .Visible = False .DisplayAlerts = False '.Workbooks.Open sFichierXls .Workbooks.Open "Z:\xx\2022\S18\PREVP0P 29042022.xlsx" '.Workbooks.Open chemin() 'With ActiveWorkbook.Worksheets("PREVP0P") '--- utilise la feuille 1 With chemin().Worksheets("PREVP0P") i = 2

09/05/2022, 16h23
EricDgn

Que vient faire chemin() dans votre code ?
Pour qu'on y comprenne quelque chose, il serait préférable de pouvoir voir l'ensemble du code. Déposez donc un fichier avec quelques données.
Codialement.
09/05/2022, 17h05
CalatheaWF

1 pièce(s) jointe(s)

En PJ le fichier que je cherche à convertir puis importer. Je n'ai pas réussi à mettre la DB Access en PJ, je l'ai mis dans l'Excel.

Quand je fais tourner la macro, c'est dans chemin que je retrouve le nom complet du chemin que je cherche à mettre dans le code TestAppli3, et puisque arrayFichiers ne fonctionnait pas j'ai tenté..

Merci par avance,
LRN
09/05/2022, 17h42
EricDgn

Votre fonction selectionFichiers fonctionne si vous en indiquez la nature du résultat, ici As Variant.

Code:

Function selectionFichiers(sourceDefault As String) As Variant

Cordialement.