Bonjour,

j'ai crée une macro VBA sous access afin de pouvoir ouvrir des queries, les rafraichir, puis les enregistrer dans un folder avant de les envoyer par mail automatique via Outlook 2010.

J'ai développé un code pour l'ensemble de ces étapes, toutefois il semblerait que VBA ne reconnaisse pas ma fonction DimOutlook As New Outlook.Application en me disant que qu'il y a une erreur de type user defined non définie. Après avoir fouillé dans les forums, il semblerait que ce souci soit lié aux références de librairie et que je doive avoir en available reference Microsoft Office 15.0.

Je n'ai toutefois pas cette référence dans ma librairie et pas sur que mon service IT puisse me l'installer, je suis donc bloqué sur Microsoft Office 14.0. Y-a-t-il un moyen de contourner ce souci avec une réécriture d'une partie du code ?

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
 
Function Refresh()
 
    Dim ObjOutlook As New Outlook.Application
    Dim oBjMail
    Dim File_name
 
    Dim datRef          As Date
    Dim strPer          As String
    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)
 
    'Determination de la date du jour
 
    datRef = Date
    strPer = ""
    strPer = Format(datRef, "YYYY_MM_DD")
 
    '1ere file Test ------------------------------------------------------------
    'groupecc = "Test"
 
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "Test", acViewNormal, acEdit
    DoCmd.RunCommand acCmdRefresh
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Test", "F:\File\"
 
    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)
 
    ChDir "F:\File" & strPer
    File_name = Application.GetOpenFilename(Title:="File_" & strPer, MultiSelect:=False)
    If Not IsArray(File_name) Then Exit Sub
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\"
    f = Dir(SigString & "*.htm")    'on prend la première signature trouvée
    If f <> "" Then
        Signature = GetBoiler(SigString & f)
        Signature = Replace(Signature, "src=""", "src=""" & SigString)
    Else
        Signature = "pas de signature trouvée"
    End If
    On Error Resume Next
 
    With oBjMail
        .Display = True    ' Ici on peut supprimer pour l'envoyer sans vérification
        .To = "test@test.com"    ' le destinataire
        .BCC = "test@test.com" 'adresse destinataires pour info
        .Subject = " test"    ' l'objet du mail
        .HTMLBody = "Hello," & Signature   'le corps du mail et la signature
        .BodyFormat = olFormatHTML    'signature outlook
        For i = 1 To UBound(File_name)
            .Attachments.Add File_name(i)    '"C:\Data\essai.txt" ' ou Nomfichier
      Next
    End With
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
 
End Sub
 
 
 
Function GetBoiler(ByVal sFile As String) As String
'OK
   Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function
Si quelqu'un a une idée je suis preneur

Merci à vous