Bonjour,

cela fait plus de 20 ans que je fais du VB avec des bases access et là je coince sur la connexion d'un nouveau projet.

Mon code on ne peut plus simple, dans une classe :

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Option Strict Off
Option Explicit On
Public Class Gestion
    Public Shared Sub EnvoieCourrielFin(StrDate As String, strSubject As String)
        Dim mMessage As Object
        Dim mConfig As Object
        Dim MyString As String
        Dim NbR As Integer
        Dim NbC As Integer
        Dim Reunion As String
        Dim LieuCourse As String
        Dim MyLib As String
        Dim Depart As String
        Dim strBody As String
        Dim HTMLBody As String
        Dim MyPos As Integer
        Dim mSch
 
        'demande de connexion
        Cn = New ADODB.Connection
        Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=Données\ACCESSMATIC.ACCDB;Persist Security Info=True"
        Cn.Open()
 
        'Chargement des données Courses
        MyString = "Select * FROM Reunions "
        MyString = MyString & "WHERE DateReunion=datevalue('" & StrDate & "') "
        MyString = MyString & "ORDER BY NumReunion"
 
        RReunion = New ADODB.Recordset
        With RReunion
            .CursorType = ADODB.CursorTypeEnum.adOpenKeyset
            .LockType = ADODB.LockTypeEnum.adLockOptimistic
            .Open(MyString, Cn, , , ADODB.CommandTypeEnum.adCmdText)
        End With
 
        RReunion.MoveFirst()
        NbR = 0
        NbC = 0
        strBody = ""
 
        If Not RReunion.EOF Then
            '***************************************************
            'On boucle sur les reunions enregistrées dans la BDD
            '***************************************************
            Do
                NumGeny = RReunion.Fields("NumGeny").Value
                Reunion = "R" & RReunion.Fields("NumReunion").Value
                LieuCourse = LCase(RReunion.Fields("LieuCourse").Value)
                MyString = "select libelle from Courses where NumGeny='" & NumGeny & "'"
                RCourses = New ADODB.Recordset
                With RCourses
                    .CursorType = ADODB.CursorTypeEnum.adOpenKeyset
                    .LockType = ADODB.LockTypeEnum.adLockOptimistic
                    .Open(MyString, Cn, , , ADODB.CommandTypeEnum.adCmdText)
                End With
                RCourses.MoveFirst()
                MyLib = RCourses.Fields(0).Value
                MyPos = InStr(MyLib, "vers ")
                Depart = Mid$(MyLib, MyPos + 5, 5)
                Do
                    NbC = +1
                    RCourses.MoveNext()
                Loop Until RCourses.EOF
                strBody = "<FONT size='4'>" & Depart & "&nbsp;<FONT color='blue'>" & Reunion & "-" & LieuCourse & "</FONT>"
                strBody = strBody & "<FONT size='4' color='red'> : " & RCourses.RecordCount & "</FONT><FONT size='4'> courses.</FONT><BR>"
                RCourses.Close()
                RCourses = Nothing
                RReunion.MoveNext()
                NbR = +1
            Loop Until RReunion.EOF
        End If
 
        RReunion.Close()
        RReunion = Nothing
        Cn.Close()
        Cn = Nothing
 
        HTMLBody = "<H3><B><font color='blue'>" & UCase(DatePronoDate.ToString("D")) & "&nbsp;&nbsp; : &nbsp;&nbsp;</font><font color='red'>"
        HTMLBody = HTMLBody & NbR & "-" & "</font>Réunions&nbsp;&nbsp;<font color='red'>" & NbC & "-" & "</font>Courses</H3>" & strBody & "</B>"
 
 
        mConfig = CreateObject("CDO.Configuration")
        mSch = mConfig.Fields
        With mSch
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxx@gmail.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxxxxxxx"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
            .Update
        End With
        mMessage = CreateObject("CDO.Message")
        With mMessage
            .Configuration = mConfig
            .To = "xxxx@gmail.com"
            .From = "xxxx@gmail.com"
            .Subject = strSubject
            .HTMLBody = HTMLBody
            .Send
        End With
        'Libère les ressources
        mMessage = Nothing
        mConfig = Nothing
        mSch = Nothing
    End Sub
End Class
J'ai l'erreur suivante :

Nom : 2022-02-14_22h04_25.png
Affichages : 392
Taille : 28,4 Ko

Si je passe par le menu visual studio de création de sources de données, pas de problème pour me connecter à la BDD.

J'ai essayé avec le package Nugets ADODB V7.0.3300.0.

Aussi avec les références suivantes :

Nom : image_2022-02-14_221237.png
Affichages : 390
Taille : 29,7 Ko

Je cherche depuis des jours et je n'y comprend rien, j'ai d'autres anciennes applications qui accèdent à la BDD sans problème mais dans ce nouveau projet :

Nom : image_2022-02-14_221516.png
Affichages : 385
Taille : 34,4 Ko

Impossible d'ouvrir la BDD ça bloque sur Cn.Open() ligne 22 !!!

D'avance merci de votre aide.

Tchicken.