Mail Rule to Run Applescript Not Working? - email

Question for my fellow AppleScripters. I have the following script which runs just fine if you run it in AppleScript Editor or Script Debugger, but that won't run at all if you try to run it from a Mail rule. The script is correctly placed in ~/Library/Application Scripts/com.apple.mail, and shows up in the "Run AppleScript" menu in the Mail rule, but simply refuses to work when new mail arrives.
on perform_mail_action(info)
tell application "Mail"
set theMessages to |SelectedMessages| of info
repeat with thisMessage in theMessages
set AppleScript's text item delimiters to {""}
set thisSender to sender of thisMessage as string
set quotepos to offset of "\"" in thisSender
if (quotepos is not 0) then
set thisSender to (text items (quotepos + 1) through -1) ¬
of thisSender as string
set quotepos to offset of "\"" in thisSender
if (quotepos is not 0) then
set thisSender to (text items 1 through (quotepos - 1)) ¬
of thisSender as string
end if
else
set atpos to offset of "#" in thisSender
if (atpos is not 0) then
set thisSender to (text items 1 through (atpos - 1)) ¬
of thisSender as string
end if
set brkpos to offset of "<" in thisSender
if (brkpos is not 0) then
set thisSender to (text items (brkpos + 1) through -1) ¬
of thisSender as string
end if
end if
tell application "Finder" to say "Mail from " & thisSender
end repeat
end tell
end perform_mail_action
Any ideas?

Thanks for the feedback everyone, but I figured out the problem. It wasn't anything to do with the script at all . . . it was that I had Satimage.osax installed in my scripting additions folder, and since it's not fully ML compatible yet, it messed everything up. Once I uninstalled it, all my folder actions started working great!
Thanks!
--Andy H.

Related

Updating my current script which modifies multiple lines into a single one

My current script copies text like this with a shortcut:
:WiltedFlower: aetheryxflower ─ 4
:Alcohol: alcohol ─ 3,709
:Ant: ant ─ 11,924
:Apple: apple ─ 15
:ArmpitHair: armpithair ─ 2
and pastes it modified into a single line
Pls trade 4 aetheryxflower 3 alcohol 11 ant 15 apple 2 armpithair <#id>
As you can see there are already two little problems, the first one is that it copies only the number/s before a comma if one existed instead of ignoring it. The second is that I always need to also copy before hitting the hotkey and start re/start the script, I've thought of modifying the script so that it uses the already selected text instead of the copied one so that I can bind it with a single hotkey.
That is my current script, it would be cool if anyone can also tell me what they used and why exactly, so that I also get better with ahk
!q::
list =
While pos := RegExMatch(Clipboard, "(\w*) ─ (\d*)", m, pos ? pos + StrLen(m) : 1)
list .= m2 " " m1 " "
Clipboard := "", Clipboard := "Pls trade " list " <#951737931159187457>"
ClipWait, 0
If ErrorLevel
MsgBox, 48, Error, An error occurred while waiting for the clipboard.
return
If the pattern of your copied text dont change, you can use something like this:
#Persistent
OnClipboardChange:
list =
a := StrSplit(StrReplace(Clipboard, "`r"), "`n")
Loop,% a.Count() {
b := StrSplit( a[A_Index], ": " )
c := StrSplit( b[2], " - " )
list .= Trim( c[2] ) " " Trim( c[1] ) " "
}
Clipboard := "Pls trade " list " <#951737931159187457>"]
ToolTip % Clipboard ; just for debug
return
With your example text, the output will be:
Pls trade aetheryxflower ─ 4 alcohol ─ 3,709 ant ─ 11,924 apple ─ 15 armpithair ─ 2 <#951737931159187457>
And this will run EVERY TIME your clipboard changes, to avoid this, you can add at the top of the script #IfWinActive, WinTitle or #IfWinExist, WinTitle depending of your need.
The answer given would solve the problem, assuming that it never changes pattern as Diesson mentions.
I did the explanation of the code you provided with comments in the code below:
!q::
list = ; initalize a blank variable
; regexMatch(Haystack, regexNeedle, OutputVar, startPos)
; just for frame of reference in explanation of regexMatch
While ; loop while 'pos' <> 0
pos := RegExMatch(Clipboard ; Haystack is the string to be searched,
in this case the Clipboard
, "(\w*) ─ (\d*)" ; regex needle in this case "capture word characters
(a-z OR A-Z OR 0-9 OR _) any number of times, space dash space
then capture any number of digits (0-9)"
, m ; output var array base name, ie first capture will be in m1
second m2 and so on.
, pos ? pos + StrLen(m) : 1) ; starting position for search
"? :"used in this way is called a ternary operator, what is saying
is "if pos<>0 then length of string+pos is start position, otherwise
start at 1". Based on the docs, this shouldn't actually work well
since 'm' in this case should be left blank
list .= m2 " " m1 " " ; append the results to the 'list' variable
followed with a space
Clipboard := "" ; clear the clipboard.
Clipboard := "Pls trade " list " <#951737931159187457>"
ClipWait, 0 ; wait zero seconds for the clipboard to change
If ErrorLevel ; if waiting zero seconds for the clipboard to change
doesn't work, give error msg to user.
MsgBox, 48, Error, An error occurred while waiting for the clipboard.
return
Frankly this code is what I would call quick and dirty, and seems unlikely to work well all the time.

Printers object in VB 6 not returning printer with special character in name

VB6 (not VB.Net or VBScript)
I'm using the Printer object and recently found that some printers
are not being returned if the name has certain characters.
In VB6 it would be something like:
Dim pr As Printer
For Each pr In Printers
MsgBox pr.DeviceName
Next pr
I can easily rename any printer in Windows (any OS version) and
make it fail.
I suspect it's related to a UTF-8/Unicode issue, but I don't know how to resolve it.
For example, this printer name works fine: "MyPrinter 1", but this does not: "MyPrinter 1 ę".
How can I get the Printer when the name has a non-standard (for US English anyway) character?
EDIT:
I've found this code to access the printers, and it will correctly return all of them, even with special characters.
However, I don't know how to either:
1) Use the object for printing (as I would with a Printers object)
2) Or set a Printer object to the returned object from WMI
(FYI - The InkEdit control will correctly show the special characters without any Unicode wrangling - I'm using for display purposes only.)
Dim strComputer As String
Dim objWMIService As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = objWMIService.ExecQuery ("Select * from Win32_Printer")
Dim myPrinter As Printer
Dim junk As String
For Each objprinter In colInstalledPrinters
List1.AddItem objprinter.Name & " --- " & objprinter.ShareName & " --- " & objprinter.ServerName
InkEdit1.Text = InkEdit1.Text & objprinter.Name & " --- " & objprinter.ShareName & " --- " & objprinter.ServerName & vbNewLine
If InStr(1, objprinter.Name, "HP") > -1 Then
myPrinter = objprinter.
End If
Next

VBScript Outlook encounters encrypted email producing error 'Entrust Entelligence Security Provider'

I have an HTA and using VBScript to loop through Outlook email folders and get folder size. The HTA is run on a shared drive by staff, it is not an administrator tool. On occasion, my company will send encrypted emails. When the VBS hits one of these emails, the following happens:
1) VBS pauses.
2) Outlook displays the 'Entrust Entelligence Security Provider' error and asks the user to click 'OK'.
3) Once OK is clicked, the VBS continues.
The Outlook message does not bring focus to Outlook, so it is possible the user will not notice the message and continue to wait for the VBS to finish.
Is there any way of avoiding this message?
Here is my code:
public TotalSize
Sub OutlookDetail
TotalSize = 0
msgbox "Depending on the size of your Outlook account, this process may take up to 60 seconds" & vbcrlf & vbcrlf & _
"If you have encrypted emails, Outlook will make a sound and give you the 'Entrust Entelligence Security Provider' message. Click 'OK' to proceed."
Const olFolderInbox = 6
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set colItems = objFolder.Items
For Each objItem in colItems
'THE OUTLOOK ERROR MAY OCCUR HERE
TotalSize = TotalSize + objItem.Size
Next
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
GetSubfolders(objInbox)
msgbox "The size of Inbox and all Subfolders: " & Round((TotalSize / 1048576),2) & " MB"
End Sub
Sub GetSubfolders(objParentFolder)
Set colFolders = objParentFolder.Folders
For Each objFolder in colFolders
Set objSubfolder = objParentFolder.Folders(objFolder.Name)
intSize = 0
Set colItems = objSubfolder.Items
For Each objItem in colItems
'THE OUTLOOK ERROR MAY ALSO OCCUR HERE
intSize = intSize + objItem.size
next
TotalSize = TotalSize + intSize
GetSubfolders objSubfolder
Next
End Sub

Using VBScript, how do I update Microsoft Outlook Inbox folder before accessing it in VBS?

The following is a VBScript (VBS) that I use the check for and process certain Outlook emails and attachments. The script finds the emails via their email address and subject. It then saves the attachment in a folder and moves the email to a folder within Outlook. (Most of this code was adapted from a stackoverflow.com post, but I have since forgotten which one.)
My issue: Sometimes this script has to be run before the user has opened Outlook for the day; therefore, none of the Outlook folders have been updated and the script can't find emails that have been sent to the user since the user shut Outlook down last.
My question: How do I update the Outlook inbox then proceed with the rest of the script ensuring that the Inbox is (or all Outlook folders are) completely updated? I'm not sure if VBS will wait for the folder update to happen, but if it won't, I, of course, need it to. I don't know how to update the inbox or wait for it to update if waiting is applicable.
Other tips on how to make the script better are welcome.
My VBScript:
Const olFolderInbox = 6
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Call SaveAndMoveAttachment("'subject 1'", objFolder)
Call SaveAndMoveAttachment("'subject 2'", objFolder)
Call SaveAndMoveAttachment("'subject 3'", objFolder)
Set objFSO = Nothing
Set objOutlook = Nothing
Set objNamespace = Nothing
WScript.Quit
Sub SaveAndMoveAttachment(sSubject, objFolder)
Set colItems = objFolder.Items
Set colFilteredItems = colItems.Restrict("[Subject] = " & sSubject)
If colFilteredItems.count = 0 then
Msgbox "An email with subject " & sSubject & " in it was not found in your Outlook Inbox"
WScript.Quit
end if
For Each objMessage In colFilteredItems
Set colAttachments = objMessage.Attachments
intCount = colAttachments.Count
If intCount <> 0 and objMessage.Sender.Address = "support#somesite.com" Then
For i = 1 To intCount
strFileName = "Z:\somepath\" & objMessage.Attachments.Item(i).FileName
objMessage.Attachments.Item(i).SaveAsFile strFileName
'move the message to somefolder folder
Set objFoldersomefolder = objNamespace.GetDefaultFolder(olFolderInbox).Folders("somefolder")
objMessage.Move objFoldersomefolder
Next
End If
Next
Set colFilteredItems = Nothing
Set colAttachments = Nothing
Set colItems = Nothing
End Sub
Add logon step between above 2 lines
WSCript.Sleep 2000
objNamespace.Logon
objNamespace.SendAndReceive(True)
Below this line:
Set objNamespace = objOutlook.GetNamespace("MAPI")
Add this:
WSCript.Sleep 2000
objNamespace.SendAndReceive(True)
I found it here:
http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_28215854.html

Vbs script to check date and extension

Hi I cant get the below script ive worked on to pickup the extension of the files, Can any help me out by pointing where I have gone wrong?
dim fileSystem, folder, file
dim path
dim count : count = 0
path = "C:\temp"
Set fileSystem = CreateObject("Scripting.FileSystemObject")
Set folder = fileSystem.GetFolder(path)
for each file in folder.Files
if file.DateLastModified > dateadd("h", -24, Now) & File.name = "txt" then
count = count + 1
end if
Next
if count < 4 then
Set WshShell = WScript.CreateObject("WScript.Shell")
strcommand = "eventcreate /T ERROR /ID 666 /L Application /SO BESROffsite /D " & _
Chr(34) & count & " Files found please check offsite copy " & Chr(34)
WshShell.Run strcommand
wScript.Quit ( 1001 )
Else
Set WshShell = WScript.CreateObject("WScript.Shell")
strcommand = "eventcreate /T Information /ID 666 /L Application /SO BESROffsite /D " & _
Chr(34) & count & " Files found offsite is working fine " & Chr(34)
WshShell.Run strcommand
wScript.Quit ( 0 )
End if
File.name is the full name including the extension, to test for the extension;
if ... fileSystem.getExtensionName(file.name) = "txt" then
You also want the logical And not the bitwise concatenating & in their too.
Alex's answer is the one you want, but just for reference if you were working just with vbs and a string filename, without the filesystemobject collection you could achieve the same via:
Right(strFilename, Len(strFilename) - Instrrev(strFilename, "."))
This essentially finds the position of the final "." in the filename, takes this away from the length of your filename, and then gives you however many character's that equals from the right hand side. This could be amended slightly to use the "Mid" command rather than the "Right" but I don't think it matters too much in a case like this.