for me, it was nice to have the possibility to separate a mail from its attachment. This way, it was possible to have it searchable within Devonthink, directly accessible, but still linked to the original mail and not occupying 2 time storage.
The new function does not put the attachment into relation with the mail and also not removes it from the mail, so it is duplicated into the database, but without relation. This adds up quickly if you deal with attachments of 2-5 MB regularly.
ChatGPT helped me modifying the initial script. to work with DT4 here is the modified version
it expects the python script in the same location as the apple script
use AppleScript version "2.4"
use scripting additions
use framework "Foundation"
property ca : a reference to current application
property pythonCmd : "/usr/bin/env python3"
property replacedTagName : "attachments-extracted"
tell application "System Events"
set scriptPath to path of (path to me)
set parentFolder to POSIX path of (container of file scriptPath)
end tell
set pythonScriptPath to parentFolder & "/replace-attachments.py"
tell application "Finder"
set replaceCmd to pythonCmd & " " & quoted form of pythonScriptPath & " "
end tell
tell application id "DNtp"
set theSelection to the selection
set tmpFolder to path to temporary items
repeat with theRecord in theSelection
repeat 1 times
-- display dialog "Verarbeite: " & (name of theRecord)
set recordPath to path of theRecord
-- display dialog "Pfad: " & recordPath & return & "Typ: " & (type of theRecord as rich text) & return & "Tags: " & (tags of theRecord as rich text)
if (type of theRecord is email or type of theRecord is unknown) and recordPath ends with ".eml" and (tags of theRecord does not contain replacedTagName) then
try
set foundAttachmentsJSON to do shell script replaceCmd & (quoted form of recordPath)
on error errMsg
display dialog "Fehler beim Python-Skript:" & return & errMsg
exit repeat
end try
if foundAttachmentsJSON is equal to "" then
display dialog "Keine Anhänge vom Python-Skript erkannt."
exit repeat
end if
set foundAttachments to my fromJSON(foundAttachmentsJSON)
-- display dialog "Gefundene Anhänge: " & (foundAttachments as rich text)
set recordReferenceURL to reference URL of theRecord
set recordSubject to name of theRecord
set recordModificationDate to modification date of theRecord
set recordCreationDate to creation date of theRecord
set recordAdditionDate to addition date of theRecord
set recordGroup to missing value
set extractedAttachments to {}
set rtfRecord to convert record theRecord to rich
-- display dialog "RTF-Konvertierungstyp: " & (type of rtfRecord as rich text)
if type of rtfRecord is RTFD then
set rtfPath to path of rtfRecord
tell rich text of rtfRecord
tell application "Finder"
set rtfAttachmentList to every file in ((POSIX file rtfPath) as alias)
-- display dialog "Anzahl Dateien im RTF: " & (count of rtfAttachmentList)
repeat with rtfAttachment in rtfAttachmentList
set rtfAttachmentName to name of rtfAttachment as string
-- display dialog "Datei im RTF: " & rtfAttachmentName
-- display dialog "Vergleiche:" & return & "RTF-Datei: " & rtfAttachmentName & return & "JSON-Anhänge: " & (foundAttachments as text) & return & "RTF (klein): " & my lowercaseText(rtfAttachmentName)
set nameFound to false
repeat with itemName in foundAttachments
if my normalizeText(rtfAttachmentName) = my normalizeText(itemName) then
set nameFound to true
exit repeat
end if
end repeat
if nameFound then
-- display dialog "TREFFER: " & rtfAttachmentName
-- ab hier: move, import usw.
end if
if my lowercaseText(rtfAttachmentName) is in (my lowercaseList(foundAttachments)) then
-- display dialog "TREFFER: " & rtfAttachmentName
set rtfAttachment to move (rtfAttachment as alias) to tmpFolder with replacing
tell application id "DNtp"
if recordGroup is missing value then
set recordGroup to create record with {name:recordSubject, type:group, creation date:recordCreationDate, modification date:recordModificationDate, addition date:recordAdditionDate} in (parent 1 of theRecord)
end if
set movedPath to POSIX path of (rtfAttachment as alias)
-- display dialog "Importiere Datei: " & movedPath
set importedItem to import path movedPath to recordGroup
set URL of importedItem to recordReferenceURL
set modification date of importedItem to recordModificationDate
set creation date of importedItem to recordCreationDate
set end of extractedAttachments to {rtfAttachmentName, ((reference URL of importedItem) as string)}
-- log message "Importiert: " & rtfAttachmentName info "Anhangsextraktion" record importedItem
end tell
end if
end repeat
end tell
if (count of extractedAttachments) > 0 then
set extractedAttachmentsJSON to my toJSON(extractedAttachments)
tell application id "DNtp"
move record theRecord to recordGroup
do shell script replaceCmd & "-r " & quoted form of extractedAttachmentsJSON & " " & quoted form of recordPath
set tags of theRecord to (tags of theRecord) & {replacedTagName}
-- log message "Anhänge ersetzt in: " & recordSubject info "Anhangsextraktion" record theRecord
end tell
end if
end tell
delete record rtfRecord
else
display dialog "RTF-Konvertierung hat kein RTFD geliefert."
end if
end if
end repeat
end repeat
end tell
on normalizeText(t)
-- Entfernt fĂźhrende/trailing Whitespace und wandelt in Kleinbuchstaben
set cleaned to do shell script "/bin/echo " & quoted form of t & " | tr '[:upper:]' '[:lower:]' | sed 's/^ *//;s/ *$//'"
return cleaned
end normalizeText
on fromJSON(strJSON)
set {x, e} to ca's NSJSONSerialization's JSONObjectWithData:((ca's NSString's stringWithString:strJSON)'s dataUsingEncoding:(ca's NSUTF8StringEncoding)) options:0 |error|:(reference)
if x is missing value then error e's localizedDescription() as text
if e â missing value then error e
if x's isKindOfClass:(ca's NSDictionary) then
return x as record
else
return x as list
end if
end fromJSON
on toJSON(theData)
set theJSONData to ca's NSJSONSerialization's dataWithJSONObject:theData options:0 |error|:(missing value)
set JSONstr to (ca's NSString's alloc()'s initWithData:theJSONData encoding:(ca's NSUTF8StringEncoding)) as text
return JSONstr
end toJSON
on lowercaseText(t)
return (do shell script "/bin/echo " & quoted form of t & " | tr '[:upper:]' '[:lower:]'")
end lowercaseText
on lowercaseList(theList)
set outList to {}
repeat with i in theList
set end of outList to my lowercaseText(i)
end repeat
return outList
end lowercaseList