Excel avec parametre

**alexmirage** · 26/04/2018, 16h59

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**mercatog** · 26/04/2018, 17h06

A la place mets un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Debug.Print sSQL

Et regarde ce que te donne

Une double quote de moins je suppose

**alexmirage** · 26/04/2018, 17h15

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Rw = Location.Row

en disant

Nom : Untitled.png
Affichages : 118
Taille : 20,0 Ko

Invité · 26/04/2018, 18h06

Bonsoir,

Je suis pas certain d'avoir tout compris.

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

**alexmirage** · 27/04/2018, 09h02

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**mercatog** · 27/04/2018, 10h45

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**alexmirage** · 27/04/2018, 11h13

En effet Mercatog je viens de corriger cela

voir le poste modifié juste avant le tiens

**mercatog** · 27/04/2018, 11h45

ç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

**alexmirage** · 27/04/2018, 15h17

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Excel avec parametre [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager