XL 2019 VBA - Ignorer erreur

[roybaf]

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...

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.

 

[roybaf]

Toutes mes excuses, mal interprèté : ECRITURE.ECR_ANNE = 2021 ne fonctionne pas ?

Oui fonctionne pas de problème.

Au final la procédure fonctionne mais toujours avec un message d'erreur a chaque nouvelle connexion qui oblige l'utilisateur a cliquer sur "OK" lorsque la fenêtre s'ouvre... c'est ce que j'essaye de résoudre sans y parvenir.

Votre code est néanmoins beaucoup plus lisible franch55, merci mais auriez vous un code alternatif? comme je commence à le proposer plus haut?

 

[fanch55]

Désolé, je n'ai pas les drivers ODBC pour ouvrir une base Mdb .

 

[Compte Supprimé 979]

Bonsoir le fil

Sur l'idée de fanch55, pourquoi mettre des vbcrlf sans les instructions SQL

Perso je ferais plutôt

Sub requete_BD()
  Dim J       As Long
  Dim Ws      As Worksheet
  Dim NomFeuille As Variant, StrSQL As String
  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
        StrSQL = "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 `" & Dossier_Base & "\D_COMPTA`.COMPTE AS COMPTE, " _
          & "`" & Dossier_Base & "\D_COMPTA`.ECRITURE AS ECRITURE, " _
          & "`" & Dossier_Base & "\D_COMPTA`.JOURNAL AS JOURNAL, " _
          & "`" & Dossier_Base & "\D_COMPTA`.LIGNE_ECRITURE AS 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>=" & Ws.Range("annee_deb").Value & " And ECRITURE.ECR_ANNEE<=" & Ws.Range("annee_deb").Value & ") " _
          & "AND (ECRITURE.ECR_MOIS>=" & Ws.Range("mois_deb").Value & " And ECRITURE.ECR_MOIS<=" & Ws.Range("mois_fin").Value & "))" _
          & "ORDER BY ECRITURE.ECR_CODE "
        .CommandText = StrSQL
        .ListObject.DisplayName = "Tableau_" & NomFeuille
        On Error Resume Next
        .Refresh 'BackgroundQuery:=False
        If Err Then MsgBox Err.Description & vbLf & StrSQL
      End With
    End If
  Next J
  Ws.Select
End Sub

Ceci dit, je ne sais pas non plus si le "`" est compris par la requête

A+

 

[fanch55]

Sur l'idée de fanch55, pourquoi mettre des vbcrlf sans les instructions SQL

Les vblf sont juste "cosmétiques" , ils permettent de rendre la zone "texte de la commande" des propriétés de connexion plus lisible :