[Access VBA] Erreur générer rapport rtf

Voici ma fonction :
Private Sub Commande4_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim BaseSQL As String
Dim strSQL As String
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT DISTINCT [Dealer/Distributor Number] FROM Query_Active_Dealer_List_Update")
Set qdf = dbs.QueryDefs("Query_Active_Dealer_List_Update")
BaseSQL = qdf.SQL
With rst
Do Until .EOF
strSQL = Left(BaseSQL, Len(BaseSQL) - 3) & " WHERE [Dealer/Distributor Number] =" & ![Dealer/Distributor Number]
qdf.SQL = strSQL
DoCmd.OutputTo acOutputReport, "Main_Report", "RichTextFormat", "C:\Documents and Settings\larocma\Dealer_Scorecards\" & ![Dealer/Distributor Number] & ".doc"

.MoveNext
Loop
.Close
End With
qdf.SQL = BaseSQL
Set qdf = Nothing
Set rst = Nothing
Set dbs = Nothing

End Sub

Le problème se situe dans la ligne strSQL = Left(BaseSQL, Len(BaseSQL) - 3) & " WHERE [Dealer/Distributor Number] =" & ![Dealer/Distributor Number]

Si je laisse ![Dealer/Distributor Number] comme ca j'obtient une erreur et aucun rapport n'est généré. Par contre, si je met "[Dealer/Distributor Number]" comme ca en paramètre et que j'entre manuellement les numeros de dealer, j'obtient des fichiers correctement.

Quelqu'un peut m'aider à résoudre ce probleme ?

Max

4 réponses

  1. Modérateur
    Salut,

    Je pense qu'il faut que tu mettes des '' pour indiquer que la comparaison se fait sur une chaîne. Et n'oublie pas non plus de fermer le SQL par un ;
    Mets des simple quote ('), c'est plus lisible que d'empiler les double quotes (guillemets """").
    Si [Dealer/Distributor Number] est numérique, alors rajoute seulement le ;
    Ca donnerait ça (selon moi):
    strSQL = Left(BaseSQL, Len(BaseSQL) - 3) & " WHERE [Dealer/Distributor Number] = '" & ![Dealer/Distributor Number] & "';"
    
    Attention cependant si [Dealer/Distributor Number] contient un nom avec une ou plusieurs simple quotes, c'est l'explosion assurée ! ;-)
    0
    1. J'ai essayé ton code mais maintenant j'obtient une erreur différente et je ne connais pas sa provenance.

      Voici le code modifié :
      Private Sub Commande4_Click()

      Dim dbs As DAO.Database
      Dim rst As DAO.Recordset
      Dim qdf As DAO.QueryDef
      Dim BaseSQL As String
      Dim strSQL As String
      Set dbs = CurrentDb
      Set rst = dbs.OpenRecordset("SELECT DISTINCT [Dealer/Distributor Number] FROM Query_Active_Dealer_List_Update")
      Set qdf = dbs.QueryDefs("Query_Active_Dealer_List_Update")
      BaseSQL = qdf.SQL
      With rst
      Do Until .EOF
      strSQL = Left(BaseSQL, Len(BaseSQL) - 3) & " WHERE [Dealer/Distributor Number] = '" & ![Dealer/Distributor Number] & "';"
      qdf.SQL = strSQL
      DoCmd.OutputTo acOutputReport, "Main_Report", "RichTextFormat", "C:\Documents and Settings\larocma\Dealer_Scorecards\" & ![Dealer/Distributor Number] & ".doc"

      .MoveNext
      Loop
      .Close
      End With
      qdf.SQL = BaseSQL
      Set qdf = Nothing
      Set rst = Nothing
      Set dbs = Nothing

      End Sub

      Erreur d'exécution '3126': Mise entre crochets non valide du nom '[Dealer/Distributor Nub
      WHERE [Dealer/Distributor Number]'
      0
      1. Si vous voulez jeter un coup d'oeil j'ai uploadé mon travail sur www.mlaroche.com/scorecards/scorecards.zip

        Le bouton est sur le Formulaire1

        Maxime
        0
        1. Modérateur
          Je n'arrive pas à faire fonctionner, il me met : impossible de créer un fichier...

          Serait-il possible qu'il n'aime pas le / dans le nom du champ ?
          0