根据电子邮件标题创建文件夹并将电子邮件移动到该文件夹

Question

我从 Windows 换成了 MacOS。

我使用VBA代码根据邮件标题在收件箱下创建了一个文件夹，并将邮件移动到该文件夹​​中。

我正在尝试对 AppleScript 做同样的事情。

如果有人可以帮助我在 AppleScript 中编写相同的逻辑，我将不胜感激（或建议以某种方式继续使用 VBA 代码的替代方案）。

Public Function ReturnNonAlpha(ByVal sString As String) As String

Dim i As Integer

For i = 1 To Len(sString)
    If Mid(sString, i, 1) Like "[0-9]" Then
        ReturnNonAlpha = ReturnNonAlpha + Mid(sString, i, 1)
    End If
Next i

End Function


Function CheckForFolder(strFolder As String) As Boolean

Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim FolderToCheck As Outlook.MAPIFolder 

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

On Error Resume Next
Set FolderToCheck = olInbox.Folders(strFolder)
On Error GoTo 0

If Not FolderToCheck Is Nothing Then
    CheckForFolder = True
End If 

ExitProc:
Set FolderToCheck = Nothing
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing

End Function


Function CreateSubFolder(strFolder As String) As Outlook.MAPIFolder

Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)
Set CreateSubFolder = olInbox.Folders.Add(strFolder)

ExitProc:
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing

End Function


Function SearchAndMove(lookFor As String)

Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim FolderToCheck As Outlook.MAPIFolder
Dim myItem As Object
Dim MyFolder As Outlook.MAPIFolder
Dim lookIn As String
Dim newName As String
Dim location As Integer
Dim endLocation As Integer

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

For Each myItem In olInbox.Items

    lookIn = myItem.Subject

    If InStr(lookIn, lookFor) Then

        endLocation = InStr(lookIn, "SUP-")
        newName = ReturnNonAlpha(lookIn)
        newName = Mid(newName, 1, 5)

        If CheckForFolder(newName) = False Then
            Set MyFolder = CreateSubFolder(newName)
            myItem.Move MyFolder
        Else
            Set MyFolder = olInbox.Folders(newName)
            myItem.Move MyFolder
        End If

    End If

Next myItem

End Function


Sub myMacro(Item As Outlook.MailItem)

Dim str As String

str = "[JIRA]"
SearchAndMove (str)

End Sub

Answer 1

我真的下定决心要找到解决方案，所以最终得到了https://hackernoon.com/automated-inbox-cleansing-with-outlook-2016-and-applescript-49cf4c4422fa的帮助

我能够编写一个满足我需要的脚本。 我想我会分享它以供将来参考，因为我在这里看不到很多关于 applescript 的信息。 该脚本基本上根据电子邮件主题在收件箱下创建一个子文件夹并将电子邮件移到那里。我写它时是考虑到自己要解决的问题，但是您可以对自己的问题进行调整。

tell application "Microsoft Outlook"
    set myInbox to folder "Inbox" of default account
    set theMessages to messages 1 through 20 of inbox

    repeat with theMessage in theMessages
      try
        set theSubject to subject of theMessage

        if theSubject contains "[JIRA]" then

            set s to quoted form of theSubject
            do shell script "sed s/[a-zA-Z\\']//g <<< " & s
            set newFolderName to the result
            set numlist to {}
            repeat with i from 1 to count of words in newFolderName
                set this_item to word i of newFolderName
                try
                    set this_item to this_item as number
                    set the end of numlist to this_item
                end try
            end repeat
            set newFolderName to first item of numlist as text
            if mail folder newFolderName exists then
                move theMessage to mail folder newFolderName of myInbox
            else
                make new mail folder at myInbox with properties {name:newFolderName}
                move theMessage to mail folder newFolderName of myInbox
            end if
        end if

    on error errorMsg
        log "Error: " & errorMsg
    end try
end repeat
end tell