XL 2019 VBA - Ignorer erreur

roybaf

XLDnaute Occasionnel
Bonjour a tous,

Je m'arrache les cheveux sur un code qui fonctionne mais qui me génère une erreur qui m'oblige à appuyer sur OK à chaque boucle...

VB:
Option Explicit

Sub requete_BD()
Dim J As Long
Dim Ws As Worksheet
Dim nomfeuille As String


  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.ErrorCheckingOptions.BackgroundChecking = False
  Set Ws = Sheets("Synthese_OCP")
  For J = 7 To Range("B" & Rows.Count).End(xlUp).Row
    If Not ExisteFeuille(Ws.Range("A" & J).Text) Then
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Ws.Range("B" & J)
      Range("A1") = Ws.Range("B" & J)
      nomfeuille = ActiveSheet.Name
      Range("A2").Select
    With Sheets(nomfeuille).ListObjects.Add(SourceType:=0, Source:= _
        "ODBC;DBQ=S:\CDWPRG\DONNEES\" & Range("A1").Value & "\D_COMPTA.MDB;DefaultDir=S:\CDWPRG\DONNEES\" & Range("A1").Value & ";Driver={Driver do Microsoft Access (*.mdb)};DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5" _
        , Destination:=Sheets(nomfeuille).Range("A2")).QueryTable
        .CommandText = Array( _
        "SELECT JOURNAL.JNL_CODE, JOURNAL.JNL_LIB, ECRITURE.ECR_CODE, LIGNE_ECRITURE.LE_CODE, ECRITURE.ECR_ANNEE, ECRITURE.E" _
        , _
        "CR_MOIS, LIGNE_ECRITURE.LE_JOUR, COMPTE.CPT_CODE, COMPTE.CPT_LIB, LIGNE_ECRITURE.LE_LIB, LIGNE_ECRITURE.LE_DEB_ORG," _
        , _
        " LIGNE_ECRITURE.LE_CRE_ORG, LIGNE_ECRITURE.LE_LET" & Chr(13) & "" & Chr(10) & "FROM `S:\cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.COMPTE COMPTE, `S:\cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.ECRITURE ECRITURE, `S:\" _
        , _
        "cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.JOURNAL JOURNAL, `S:\cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.LIGNE_ECRITURE LIGNE_ECRITURE" & Chr(13) & "" & Chr(10) & "WHERE COMPTE.CPT_CODE = LIGNE_ECRITURE.CPT_CODE AND ECRITURE.ECR_CODE = LIGNE_EC" _
        , _
        "RITURE.ECR_CODE AND ECRITURE.JNL_CODE = JOURNAL.JNL_CODE AND ((ECRITURE.ECR_ANNEE>=" & Sheets("Synthese_OCP").Range("annee_deb").Value & " And ECRITURE.ECR_ANNEE<=" & Sheets("Synthese_OCP").Range("annee_deb").Value & ") AND (ECRITURE.ECR_MOIS>=" & Sheets("Synthese_OCP").Range("mois_deb").Value & "And ECRITURE.ECR_MOIS<=" & Sheets("Synthese_OCP").Range("mois_fin").Value & "))" & Chr(13) & "" & Chr(10) & "ORDER BY ECRITURE.ECR_CODE" _
        )
        .ListObject.DisplayName = "Tableau_" & Ws.Range("B" & J)
        .Refresh 'BackgroundQuery:=False
    End With
      
    End If
  Next J
  Ws.Select
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  Application.ErrorCheckingOptions.BackgroundChecking = True
 
End Sub


Function ExisteFeuille(Nom As String) As Boolean
  On Error Resume Next
  ExisteFeuille = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function

J'ai un message : erreur inattendue
La valeur n'est pas comprise dans la plage attendue

Pourtant une fois que je valide et arrive au bout, toutes les données sont importées sans erreurs...

Comment je peux ignorer cette erreur?

On erreur resume next ne fonctionne pas...


Merci à vous par avance

Cyril.
 

cp4

XLDnaute Barbatruc
ou comme ceci
VB:
With Sheets(nomfeuille)
                On Error Resume Next
                .ListObjects.Add(SourceType:=0, Source:= _
                                 "ODBC;DBQ=S:\CDWPRG\DONNEES\" & Range("A1").Value & "\D_COMPTA.MDB;DefaultDir=S:\CDWPRG\DONNEES\" & Range("A1").Value & ";Driver={Driver do Microsoft Access (*.mdb)};DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5" _
                                 , Destination:=Sheets(nomfeuille).Range("A2")).QueryTable
                On Error GoTo 0

                .CommandText = Array( _
                               "SELECT JOURNAL.JNL_CODE, JOURNAL.JNL_LIB, ECRITURE.ECR_CODE, LIGNE_ECRITURE.LE_CODE, ECRITURE.ECR_ANNEE, ECRITURE.E" _
                               , _
                               "CR_MOIS, LIGNE_ECRITURE.LE_JOUR, COMPTE.CPT_CODE, COMPTE.CPT_LIB, LIGNE_ECRITURE.LE_LIB, LIGNE_ECRITURE.LE_DEB_ORG," _
                               , _
                               " LIGNE_ECRITURE.LE_CRE_ORG, LIGNE_ECRITURE.LE_LET" & Chr(13) & "" & Chr(10) & "FROM `S:\cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.COMPTE COMPTE, `S:\cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.ECRITURE ECRITURE, `S:\" _
                               , _
                               "cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.JOURNAL JOURNAL, `S:\cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.LIGNE_ECRITURE LIGNE_ECRITURE" & Chr(13) & "" & Chr(10) & "WHERE COMPTE.CPT_CODE = LIGNE_ECRITURE.CPT_CODE AND ECRITURE.ECR_CODE = LIGNE_EC" _
                               , _
                               "RITURE.ECR_CODE AND ECRITURE.JNL_CODE = JOURNAL.JNL_CODE AND ((ECRITURE.ECR_ANNEE>=" & Sheets("Synthese_OCP").Range("annee_deb").Value & " And ECRITURE.ECR_ANNEE<=" & Sheets("Synthese_OCP").Range("annee_deb").Value & ") AND (ECRITURE.ECR_MOIS>=" & Sheets("Synthese_OCP").Range("mois_deb").Value & "And ECRITURE.ECR_MOIS<=" & Sheets("Synthese_OCP").Range("mois_fin").Value & "))" & Chr(13) & "" & Chr(10) & "ORDER BY ECRITURE.ECR_CODE" _
                               )
                .ListObject.DisplayName = "Tableau_" & Ws.Range("B" & J)
                .Refresh    'BackgroundQuery:=False
            End With
 

fanch55

XLDnaute Barbatruc
Bonjour le fil,
Code corrigé du classeur fourni .
C'est la première fois que je vois un .commandtext = array(),
cela semble pouvoir fonctionner mais nuit un peu à la lisibilité du code
Le classeur était incorrect car il y a des cellules avec des #Ref et le code cherchait une valeur dans la colonne A qui n'est pas renseignée .
A défaut de pouvoir tester car pas de base Mdb sur mon poste, il semblerait que l'erreur 1004 soit Errerur générale Odbc, ce qui pourrait être du fait du driver Access non installé avec ce nom ...
VB:
Voir post suivant
 
Dernière édition:

roybaf

XLDnaute Occasionnel
Bonjour le fil,
Code corrigé du classeur fourni .
C'est la première fois que je vois un .commandtext = array(),
cela semble pouvoir fonctionner mais nuit un peu à la lisibilité du code
Le classeur était incorrect car il y a des cellules avec des #Ref et le code cherchait une valeur dans la colonne A qui n'est pas renseignée .
A défaut de pouvoir tester car pas de base Mdb sur mon poste, il semblerait que l'erreur 1004 soit Errerur générale Odbc, ce qui pourrait être du fait du driver Access non installé avec ce nom ...
VB:
Option Explicit

Sub requete_BD()
Dim J       As Long
Dim Ws      As Worksheet
Dim NomFeuille As Variant, Sel As Variant

    Application.ScreenUpdating = False
 
    Set Ws = Sheets("Synthese_OCP")
    For J = 7 To Ws.Range("B" & Ws.Rows.Count).End(xlUp).Row
        NomFeuille = Ws.Range("B" & J)
        If Not IsError(NomFeuille) Then
            If Not ExisteFeuille(NomFeuille) Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = NomFeuille
            Range("A1") = NomFeuille
            With Sheets(NomFeuille).ListObjects.Add( _
                SourceType:=0, _
                Source:="ODBC;" & _
                        "DBQ=S:\CDWPRG\DONNEES\" & NomFeuille & "\D_COMPTA.MDB;" & _
                        "DefaultDir=S:\CDWPRG\DONNEES\" & NomFeuille & ";" & _
                        "Driver={Driver do Microsoft Access (*.mdb)};" & _
                        "DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5", _
                Destination:=Sheets(NomFeuille).Range("A2")).QueryTable
                Sel = _
                "SELECT JOURNAL.JNL_CODE, JOURNAL.JNL_LIB, " & _
                "       ECRITURE.ECR_CODE, LIGNE_ECRITURE.LE_CODE, ECRITURE.ECR_ANNEE,ECRITURE.ECR_MOIS, " & _
                "       LIGNE_ECRITURE.LE_JOUR, COMPTE.CPT_CODE, COMPTE.CPT_LIB, LIGNE_ECRITURE.LE_LIB, LIGNE_ECRITURE.LE_DEB_ORG," & _
                "       LIGNE_ECRITURE.LE_CRE_ORG, LIGNE_ECRITURE.LE_LET" & _
                "  FROM `S:\cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.COMPTE COMPTE, " & _
                "       `S:\cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.ECRITURE ECRITURE " & _
                "       `S:\cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.JOURNAL JOURNAL, " & _
                "       `S:\cdwprg\donnees\" & Range("A1").Value & "\D_COMPTA`.LIGNE_ECRITURE LIGNE_ECRITURE" & _
                " WHERE COMPTE.CPT_CODE = LIGNE_ECRITURE.CPT_CODE " & _
                "   AND ECRITURE.ECR_CODE = LIGNE_ECRITURE.ECR_CODE " & _
                "   AND ECRITURE.JNL_CODE = JOURNAL.JNL_CODE " & _
                "   AND ( (ECRITURE.ECR_ANNEE>=" & Sheets("Synthese_OCP").Range("annee_deb").Value & " And ECRITURE.ECR_ANNEE<=" & Sheets("Synthese_OCP").Range("annee_deb").Value & ") " & _
                "     AND (ECRITURE.ECR_MOIS>=" & Sheets("Synthese_OCP").Range("mois_deb").Value & " And ECRITURE.ECR_MOIS<=" & Sheets("Synthese_OCP").Range("mois_fin").Value & ")" & _
                "        )" & _
                "   ORDER BY ECRITURE.ECR_CODE "
                .CommandText = Sel
                .ListObject.DisplayName = "Tableau_" & NomFeuille
                On Error Resume Next
                .Refresh 'BackgroundQuery:=False
                If Err Then MsgBox Err.Description
            End With
        End If
    Next J
 
    Ws.Select

End Sub
Function ExisteFeuille(Nom) As Boolean:  ExisteFeuille = False
  On Error Resume Next
    ExisteFeuille = Sheets(Nom).Name <> ""
    ExisteFeuille = Err = 0
  On Error GoTo 0
End Function
J'ai inséré votre code et le msg box me retourne : Erreur de syntaxe SQL
 

roybaf

XLDnaute Occasionnel
J'ai inséré votre code et le msg box me retourne : Erreur de syntaxe SQL
De plus, avec ce code, les données ne chargent plus lorsque je valide l'erreur.

Est-ce que cela ne serait pas du au fait que la version de la mdb soit sur une version 32 bits et excel 64 bits ou quelques chose comme ca? je lis différentes choses depuis hier et ceux qui rencontrent ces erreurs mentionnent ce point...
 
Dernière édition:

fanch55

XLDnaute Barbatruc
J'ai inséré votre code et le msg box me retourne : Erreur de syntaxe SQL
Exact, oubli d'une virgule dans la requête :
VB:
Option Explicit

Sub requete_BD()
Dim J       As Long
Dim Ws      As Worksheet
Dim NomFeuille As Variant, Sel As Variant
Dim Dossier_Base As String

    Application.ScreenUpdating = False
   
    
    Set Ws = Sheets("Synthese_OCP")
    For J = 7 To Ws.Range("B" & Ws.Rows.Count).End(xlUp).Row
        NomFeuille = Ws.Range("B" & J)
        If Not IsError(NomFeuille) Then
            If Not ExisteFeuille(NomFeuille) Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = NomFeuille
            Range("A1") = NomFeuille
            Dossier_Base = "S:\CDWPRG\DONNEES\" & NomFeuille
            With Sheets(NomFeuille).ListObjects.Add( _
                SourceType:=0, _
                Source:="ODBC;" & _
                        "DBQ=" & Dossier_Base & "\D_COMPTA.MDB;" & _
                        "DefaultDir=" & Dossier_Base & ";" & _
                        "Driver={Driver do Microsoft Access (*.mdb)};" & _
                        "DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5", _
                Destination:=Sheets(NomFeuille).Range("A2")).QueryTable
                Sel = _
                "SELECT JOURNAL.JNL_CODE, JOURNAL.JNL_LIB, " & _
                "       ECRITURE.ECR_CODE, LIGNE_ECRITURE.LE_CODE, ECRITURE.ECR_ANNEE,ECRITURE.ECR_MOIS, " & vbLf & _
                "       LIGNE_ECRITURE.LE_JOUR, COMPTE.CPT_CODE, COMPTE.CPT_LIB, LIGNE_ECRITURE.LE_LIB, LIGNE_ECRITURE.LE_DEB_ORG," & vbLf & _
                "       LIGNE_ECRITURE.LE_CRE_ORG, LIGNE_ECRITURE.LE_LET " & vbLf & _
                "  FROM `" & Dossier_Base & "\D_COMPTA`.COMPTE         COMPTE, " & vbLf & _
                "       `" & Dossier_Base & "\D_COMPTA`.ECRITURE       ECRITURE, " & vbLf & _
                "       `" & Dossier_Base & "\D_COMPTA`.JOURNAL        JOURNAL, " & vbLf & _
                "       `" & Dossier_Base & "\D_COMPTA`.LIGNE_ECRITURE LIGNE_ECRITURE" & vbLf & _
                " WHERE COMPTE.CPT_CODE = LIGNE_ECRITURE.CPT_CODE " & vbLf & _
                "   AND ECRITURE.ECR_CODE = LIGNE_ECRITURE.ECR_CODE " & vbLf & _
                "   AND ECRITURE.JNL_CODE = JOURNAL.JNL_CODE " & vbLf & _
                "   AND ( (ECRITURE.ECR_ANNEE>=" & Ws.Range("annee_deb").Value & " And ECRITURE.ECR_ANNEE<=" & Ws.Range("annee_deb").Value & ") " & vbLf & _
                "     AND (ECRITURE.ECR_MOIS>=" & Ws.Range("mois_deb").Value & " And ECRITURE.ECR_MOIS<=" & Ws.Range("mois_fin").Value & ")" & vbLf & _
                "        )" & _
                "   ORDER BY ECRITURE.ECR_CODE "
                .CommandText = Sel
                .ListObject.DisplayName = "Tableau_" & NomFeuille
                On Error Resume Next
                .Refresh 'BackgroundQuery:=False
                If Err Then MsgBox Err.Description & vbLf & Sel
            End With
        End If
    Next J
    
    Ws.Select

End Sub


Function ExisteFeuille(Nom) As Boolean:  ExisteFeuille = False
  On Error Resume Next
    ExisteFeuille = Sheets(Nom).Name <> ""
    ExisteFeuille = Err = 0
  On Error GoTo 0
End Function
Ce qui donne cette connexion :
1638712611273.png


Sinon, pourquoi cette specif dans le Where ?
(ECRITURE.ECR_ANNEE>=2021 And ECRITURE.ECR_ANNEE<=2021)
 

roybaf

XLDnaute Occasionnel
Exact, oubli d'une virgule dans la requête :
VB:
Option Explicit

Sub requete_BD()
Dim J       As Long
Dim Ws      As Worksheet
Dim NomFeuille As Variant, Sel As Variant
Dim Dossier_Base As String

    Application.ScreenUpdating = False
  
   
    Set Ws = Sheets("Synthese_OCP")
    For J = 7 To Ws.Range("B" & Ws.Rows.Count).End(xlUp).Row
        NomFeuille = Ws.Range("B" & J)
        If Not IsError(NomFeuille) Then
            If Not ExisteFeuille(NomFeuille) Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = NomFeuille
            Range("A1") = NomFeuille
            Dossier_Base = "S:\CDWPRG\DONNEES\" & NomFeuille
            With Sheets(NomFeuille).ListObjects.Add( _
                SourceType:=0, _
                Source:="ODBC;" & _
                        "DBQ=" & Dossier_Base & "\D_COMPTA.MDB;" & _
                        "DefaultDir=" & Dossier_Base & ";" & _
                        "Driver={Driver do Microsoft Access (*.mdb)};" & _
                        "DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5", _
                Destination:=Sheets(NomFeuille).Range("A2")).QueryTable
                Sel = _
                "SELECT JOURNAL.JNL_CODE, JOURNAL.JNL_LIB, " & _
                "       ECRITURE.ECR_CODE, LIGNE_ECRITURE.LE_CODE, ECRITURE.ECR_ANNEE,ECRITURE.ECR_MOIS, " & vbLf & _
                "       LIGNE_ECRITURE.LE_JOUR, COMPTE.CPT_CODE, COMPTE.CPT_LIB, LIGNE_ECRITURE.LE_LIB, LIGNE_ECRITURE.LE_DEB_ORG," & vbLf & _
                "       LIGNE_ECRITURE.LE_CRE_ORG, LIGNE_ECRITURE.LE_LET " & vbLf & _
                "  FROM `" & Dossier_Base & "\D_COMPTA`.COMPTE         COMPTE, " & vbLf & _
                "       `" & Dossier_Base & "\D_COMPTA`.ECRITURE       ECRITURE, " & vbLf & _
                "       `" & Dossier_Base & "\D_COMPTA`.JOURNAL        JOURNAL, " & vbLf & _
                "       `" & Dossier_Base & "\D_COMPTA`.LIGNE_ECRITURE LIGNE_ECRITURE" & vbLf & _
                " WHERE COMPTE.CPT_CODE = LIGNE_ECRITURE.CPT_CODE " & vbLf & _
                "   AND ECRITURE.ECR_CODE = LIGNE_ECRITURE.ECR_CODE " & vbLf & _
                "   AND ECRITURE.JNL_CODE = JOURNAL.JNL_CODE " & vbLf & _
                "   AND ( (ECRITURE.ECR_ANNEE>=" & Ws.Range("annee_deb").Value & " And ECRITURE.ECR_ANNEE<=" & Ws.Range("annee_deb").Value & ") " & vbLf & _
                "     AND (ECRITURE.ECR_MOIS>=" & Ws.Range("mois_deb").Value & " And ECRITURE.ECR_MOIS<=" & Ws.Range("mois_fin").Value & ")" & vbLf & _
                "        )" & _
                "   ORDER BY ECRITURE.ECR_CODE "
                .CommandText = Sel
                .ListObject.DisplayName = "Tableau_" & NomFeuille
                On Error Resume Next
                .Refresh 'BackgroundQuery:=False
                If Err Then MsgBox Err.Description & vbLf & Sel
            End With
        End If
    Next J
   
    Ws.Select

End Sub


Function ExisteFeuille(Nom) As Boolean:  ExisteFeuille = False
  On Error Resume Next
    ExisteFeuille = Sheets(Nom).Name <> ""
    ExisteFeuille = Err = 0
  On Error GoTo 0
End Function
Ce qui donne cette connexion :
Regarde la pièce jointe 1123864

Sinon, pourquoi cette specif dans le Where ?
Dans la base j'ai des écritures qui seront a cheval sur 2021 et 2022, je limite la requête à 1 période correspondante au millésime d'une année
 

roybaf

XLDnaute Occasionnel
N'y a t-il pas moyen d'appeler les enregistrements 1 à 1 et de compléter le classeur j'assaye de débuter un code, j'alimente la première colonne mais n'arrive pas à intégrer les autres tables et dérouler la procédure :

VB:
Sub requete_BD()
Dim J As Long
Dim Ws As Worksheet
Dim nomfeuille As String
Dim enr As Recordset
Dim base As Database


chemin_bd = "s:\CDWPRG\DONNEES\" & Range("W1").Value & "\D_COMPTA.MDB"

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
Set base = DBEngine.OpenDatabase(chemin_bd)
Set enr = base.OpenRecordset("SELECT * from JOURNAL", dbOpenDynaset)

enr.MoveFirst

Do

ligne = ligne + 1

Cells(ligne, 1).Value = enr.Fields("JNL_CODE").Value


enr.MoveNext

Loop Until enr.EOF = True

enr.Close
base.Close

Set enr = Nothing
Set base = Nothing
 

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla