Excel avec parametre

Version imprimable

Bonjour,

Suite a la création d'une macro pour charger les data de ma db dans un excel , j'ai voulu automatiser l'envoi d'un mail vers certaines personnes contenue dans une sheet.

Dans la partir rappatrier les données pas de problemes mais des que je fais une query un peu plus spéciale

il ne veut plus boucler :/ et j'obtiens un vilain erreur 91 variable not set

si je fais un select * from table

je n'ai aucun probleme :/

j'avoue patauger un max n'étant pas un VBA addict

si quelqu'un pouvait me guider cela m'aiderait

MErci d'avance

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
Sub Access_Data()
 
    Dim Cn As ADODB.Connection, Rs As ADODB.Recordset
    Dim MyConn, sSQL As String
    Dim Nom, Prenom, search As String
    Dim Rw As Long, Col As Long, c As Long
    Dim MyField, Location As Range
 
    'Set destination
     Set Location = [A1]
    ' Set Location = ThisWorkbook.Worksheets("import").Range("A1")
    ' Set source
     MyConn = "DB.accdb"
 
    For i = 2 To ThisWorkbook.Worksheets("input").Range("M" & Rows.count).End(xlUp).Row
    With test
    Nom = ThisWorkbook.Worksheets("input").Range("M" & i).Value
    Prenom = ThisWorkbook.Worksheets("input").Range("N" & i).Value
    search = UCase(Nom + Prenom)
    End With
 
    sSQL = "SELECT dbo_vw_Persons.int_e_mail_adress, dbo_vw_Persons.refogID FROM dbo_vw_Persons " & _
    "WHERE SEARCH_USUAL_NAME =" & Chr(34) & search & """ AND EXIT_DT IS NULL"
 
    MsgBox ("la query : ") & sSQL & ""
 
    'connection phase & SQL statement
    Set Cn = New ADODB.Connection
    With Cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Open MyConn
        Set Rs = .Execute(sSQL)
    End With
   'Write RecordSet to results area
    Rw = Location.Row
    Col = Location.Column
    c = Col
      Do Until Rs.EOF
        For Each MyField In Rs.Fields
            Cells(Rw, c) = MyField
            MsgBox (" : ") & MyField & ""
            c = c + 1
        Next MyField
        Rs.MoveNext
        Rw = Rw + 1
        c = Col
     Loop
     Set Location = Nothing
     Set Cn = Nothing
    Next i
End Sub

26/04/2018, 17h06
mercatog
A la place mets un
Code:

1 2 Debug.Print sSQL
Et regarde ce que te donne

Une double quote de moins je suppose
26/04/2018, 17h15
alexmirage

1 pièce(s) jointe(s)

Merci de ta réponse rapide mercatog :)

J'avais évidement déjà essayé avec le debug, c'est meme pour cela que j'affiche ma query via une msgbox

jarrive meme a voir toutes mes query correctes si je deplace mon Next i apres la definitionde la query sSQL

je bug réellement ...

quand je remet ma boucle en fin de macro j obtient la premiere boucle et l ecriture dans mon sheet mais a la 2 eme boucle il me donne

erreur sur

Code:

Rw = Location.Row

en disant

Pièce jointe 373357
26/04/2018, 18h06
Invité

Bonsoir,

Je suis pas certain d'avoir tout compris.

https://www.developpez.net/forums/d1.../#post10169353

Bonjour ,

je vais essayer d expliquer au mieux mon objectif :)

J'ai un sheet excel contenant des noms et prenoms et grace a cet input je veux aller rechercher leurs adresses emailq dans une db access et les inserer dans une nouvelle sheet.

il m'insere bien la premiere adresse dans la cellule A1 mais ne continue pas pour la seconde, pourtant l'affichage du resultat de la query est correct donc je ne comprends pas pourquoi ca ne fonctionne pas. D'autant que lorsque je charge toute la table contenant les adresses mails je n'ai aucun souci mon sheet est completement chargé

ce que je ne comprends pas c'est comment mon recordsetcount est a -1

alors qu il devrait etre au nombre de record trouvé par la query :/

je ne sais pas si j'ai été clair

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
Sub Access_Data()
 
    Dim Cn As ADODB.Connection, Rs As ADODB.Recordset
    Dim MyConn, sSQL As String
    Dim Nom, Prenom, search As String
    Dim Rw As Long, Col As Long, c As Long
    Dim MyField, Location As Range
 
    'Set destination
     Set Location = [A1]
    ' Set Location = ThisWorkbook.Worksheets("import").Range("A1")
    ' Set source
     MyConn = "DB.accdb"
 
     'connection phase & SQL statement
    Set Cn = New ADODB.Connection
    With Cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Open MyConn
 
    End With
 
    For i = 2 To ThisWorkbook.Worksheets("input").Range("M" & Rows.count).End(xlUp).Row
    With test
    Nom = ThisWorkbook.Worksheets("input").Range("M" & i).Value
    Prenom = ThisWorkbook.Worksheets("input").Range("N" & i).Value
    search = UCase(Nom + Prenom)
    End With
 
    sSQL = "SELECT dbo_vw_Persons.int_e_mail_adress, dbo_vw_Persons.refogID FROM dbo_vw_Persons " & _
    "WHERE SEARCH_USUAL_NAME =" & Chr(34) & search & """ AND EXIT_DT IS NULL"
 
    MsgBox ("la query : ") & sSQL & ""
 
 
    Set Rs = Cn.Execute(sSQL)
   'Write RecordSet to results area
    Rs.MoveFirst
 
 
    Rw = Location.Row
    Col = Location.Column
    c = Col
 
      Do
        For Each MyField In Rs.Fields
            Cells(Rw, c) = MyField
            MsgBox (" : ") & MyField & ""
            c = c + 1
        Next MyField
        Rs.MoveNext
        Rw = Rw + 1
        c = Col
 
     Loop While Rs.EOF
 
 
 
 
     Next i
    Set Location = Nothing
    Set Cn = Nothing
    Set Rs = Nothing
End Sub

merci de ton interet

alex

Normal, tu as mis Set Location=Nothing avant la boucle

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
'....
        'connection phase & SQL statement
        Set Cn = New ADODB.Connection
        With Cn
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .Open MyConn
            Set Rs = .Execute(sSQL)
        End With
        'Write RecordSet to results area
 
        Do Until Rs.EOF
            For Each MyField In Rs.Fields
                Location.Offset(Rw, c) = MyField
                c = c + 1
            Next MyField
            Rs.MoveNext
            Rw = Rw + 1
            c = 0
        Loop
        Rs.Close
        Set Rs = Nothing
        Cn.Close
        Set Cn = Nothing
    Next i
End With
Set Location = Nothing
End Sub

27/04/2018, 11h13
alexmirage

En effet Mercatog je viens de corriger cela :) voir le poste modifié juste avant le tiens
27/04/2018, 11h45
mercatog

ça a corrigé ton problème ou non?

J'ai testé sur une de mes bases Access, en mettant le chemin complet et en adaptant la requête sSQL

Alors tout d'abord un grand merci pour l'aide et voici le code corrigé qui fonctionne :)

En effet le problème venait en partie du fait que la remise à zero des variables etait dans la boucle ensuite que le résultat de la query n'est pas toujours ok

et donc pour palier a cela j'ai mis un on error resume next (temporaire)

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
Sub Access_Data()
 
    Dim Cn As ADODB.Connection, Rs As ADODB.Recordset
    Dim MyConn, sSQL As String
    Dim Nom, Prenom, search As String
    Dim Rw As Long, Col As Long, c As Long
    Dim MyField, Location As Range
 
 
    Rw = 1
    Col = 1
    c = 1
 
     MyConn = "DB.accdb"
 
     'connection phase & SQL statement
    Set Cn = New ADODB.Connection
    With Cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Open MyConn
 
    End With
 
    For i = 2 To ThisWorkbook.Worksheets("input").Range("M" & Rows.count).End(xlUp).Row
    With test
    Set Location = ThisWorkbook.Worksheets("import").Range("A" & i)
    Nom = ThisWorkbook.Worksheets("input").Range("M" & i).Value
    Prenom = ThisWorkbook.Worksheets("input").Range("N" & i).Value
    search = UCase(Nom + Prenom)
    End With
 
    sSQL = "SELECT dbo_vw_Persons.int_e_mail_adress, dbo_vw_Persons.refogID FROM dbo_vw_Persons " & _
    "WHERE SEARCH_USUAL_NAME =" & Chr(34) & search & """ AND EXIT_DT IS NULL"
 
    'MsgBox ("la query : ") & sSQL & ""
 
 
    Set Rs = Cn.Execute(sSQL)
   'Write RecordSet to results area
 
 
       Do
 
        For Each MyField In Rs.Fields
            Cells(Rw, c) = MyField
            On Error Resume Next
 
            c = c + 1
        Next MyField
        Rs.MoveNext
        Rw = Rw + 1
        c = Col
 
     Loop Until Rs.EOF
 
     Next i
    Set Location = Nothing
    Set Cn = Nothing
    Set Rs = Nothing
End Sub

Bien à vous

alex