Bonjour,

J'ai une base MySQL avec une liste d'entrées et leur id respectifs.
Je souhaiterai pouvoir exporter des emails et ensuite les mettre en lien avec ces entrées.

Je suis novice en Macro sur Outlook.

Je pensais sauver les emails sur le disque, et ensuite mettre une entrée dans mysql avec le lien vers le fichier créé, et l'identifiant qui serait choisi dans une liste déroulante.

J'ai déja réussi à exporter le fichier au format MSG.

Je pensais appeler un script PHP par POST qui retournerai la liste de mes entrées au format JSON, pour ensuite appeler un nouveau script php à qui je passerai l'id choisi et le lien vers le fichier créé.

Je ne suis pas certain de ma solution, car cela implique de créer un dossier partagé visible par tous localisé sur le serveur Web, pour y mettre les emails exporté.

Peut être faudrait il passer par un champs LONGBLOB, qui serait directement renseigné par outlook.

Comment réaliser un appel POST, puis comment remplir une liste déroulante avec un retour (ECHO) en JSON?

Merci d'avance à tous les généreux contributeurs !


Voila mon code pour enregistrer:

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
Sub SaveAsMsg(strFolderPath As String, blnOverwrite)
    Dim objItem As MailItem
    ' requires reference to Microsoft Scripting Runtime
    ' \Windows\System32\Scrrun.dll
 
 
    Dim fso As FileSystemObject
    Dim strSubject As String
    Dim strSaveName As String
    Dim strMsg As String
    Dim intRes As Integer
 
    Set objItem = GetCurrentItem()
    If Not objItem Is Nothing Then
        If GoodFolderPath(strFolderPath) <> "PATH DOES NOT EXIST" Then
            strSubject = CleanFileName(objItem.Subject)
            If Right(strSubject, 1) <> "." Then
                strSaveName = strSubject & ".msg"
                Set fso = CreateObject("Scripting.FileSystemObject")
                If blnOverwrite = False Then
                    Do While fso.FileExists(strFolderPath & strSaveName)
                        strSaveName = strSubject & _
                                    Format(Now, " hhnnssddmmyyyy") & ".msg"
                    Loop
                Else
                    If fso.FileExists(strFolderPath & strSaveName) Then
                        fso.DeleteFile strFolderPath & strSaveName
                    End If
                End If
                objItem.SaveAs strFolderPath & strSaveName, olMSG
            End If
        End If
    End If
 
    Set fso = Nothing
End Sub
 
Function GetCurrentItem() As Object
    On Error Resume Next
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = Application.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = Application.ActiveInspector.CurrentItem
        Case Else
            ' anything else will result in an error, which is
            ' why we have the error handler above
    End Select
End Function
 
Function GoodFolderPath(strPath) As String
    Dim fso As FileSystemObject
    On Error Resume Next
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    If strPath <> "" Then
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        ' check for existence of folder
        If Not fso.FolderExists(strPath) Then
            strMsg = "This folder -- " & strPath & _
                     " -- does not exist. Do you want to create it?"
            intRes = MsgBox(strMsg, vbDefaultButton1 + vbQuestion + vbYesNo, "SaveAsMsg")
            If intRes = vbYes Then
                fso.CreateFolder strPath
                If Err = 0 Then
                    GoodFolderPath = strPath
                Else
                    GoodFolderPath = "PATH DOES NOT EXIST"
                End If
            Else
                GoodFolderPath = "PATH DOES NOT EXIST"
            End If
        End If
    End If
 
    Set fso = Nothing
End Function
 
Function CleanFileName(strText As String) As String
    Dim strStripChars As String
    Dim intLen As Integer
    Dim i As Integer
    strStripChars = "/\[]:=," & Chr(34)
    intLen = Len(strStripChars)
    strText = Trim(strText)
    For i = 1 To intLen
        strText = Replace(strText, Mid(strStripChars, i, 1), "")
    Next
    CleanFileName = strText
End Function