Normally we'd share a file within Explorer or Dopus using SendTo or Copy SENDMAIL command, but sadly it'll always lead to an Email compiled with plain text describing non-sense and with a Subject prefix un-customizable "ready to share...".
Inspired by the VBScript found here Joseph's Script Method, I implemented same approach in DOpus VBS commandbutton.
How does it work:
Down load the script in.dcf format
Drag it onto your desired toolbar position in customizing status, assign one hotkey to it if you like (mine is F11)
Edit it to ensure it fits your environment
Outlook installed
you've prepared some Outlook pre-defined signature (at least 1)
change your username in the script row of the signature path (following my remark)
(optional) change the text prefixes following my remark of the code
select file (1 or multiple) and then click the button or hotkey, mail will popup
folders will be ignored
Multiple files supported
This is my first publish here (i am a beginner of DOpus Scripts), and a lot of credits go to Joseph's Script, and also I received help from DOpus developers in this forum today. Thanks to all.
If you find bugs or other optimization wishes, please feel free to leave comment here -- I'd try my very best. 1Click_Mail.dcf (4.0 KB)
This seems useful but I can't get it to work. I have changed the path to include my username but that doesn't make any difference.
Here is the error message:
Selected items in C:\Users\uksjw602\Desktop:
(f) C:\Users\uksjw602\Desktop\test.txt
C:\Users\uksjw602\Desktop\test.txt
25/02/2019 17:03 Error at line 41, position 1
25/02/2019 17:03 Path not found (0x800a004c)
Furthermore, if you change the username in the original code to strSigFilePath = "C:\Users\%username%\AppData\Roaming\Microsoft\Signatures\" the end user will not have to adjust it manually.
It looks like it's trying to load a signature from a file called "Short_en.htm" in that folder. You'd need to make sure that file's there as well as adjusting the path.
Thanks Jon, that was part of the problem but it seems like %username% doesn't work either. You have to enter your full username instead, which is no big deal.
@Bryan.H Please disregard the %username% suggestion in my previous message.
Done that but it still doesn't work for me. Here's the adapted code:
Full Code
Option Explicit
Function OnClick(ByRef clickData)
DOpus.ClearOutput
Dim cmd, lister, tab, selItem, folderEnum, folderItem
' ---------------------------------------------------------
Set cmd = clickData.func.command
cmd.deselect = false ' Prevent automatic deselection
Dim OutApp, oNameSpace, oInbox, oEmailItem, olMailItem
Dim a, oAttachments, subjectStr, olFormatHTML
Dim objFSO,strSigFilePath, objSignatureFile, strBuffer, strText
olMailItem = 0
olFormatHTML = 2
Set OutApp = CreateObject("Outlook.Application") 'opens Outlook
Set oEmailItem = OutApp.CreateItem(olMailItem) 'opens new email
Const LineBreak = "<br>"
DOpus.Output "Selected items in " & clickData.func.sourcetab.path & ":"
If clickData.func.sourcetab.selected.count = 0 Then
DOpus.Output " (none)"
Exit function
Else
For Each selItem in clickData.func.sourcetab.selected
If (selItem.is_dir) Then
DOpus.Output " (d) " & selItem.RealPath
Else
DOpus.Output " (f) " & selItem.RealPath
' Set oAttachments = oEmailItem.Attachments.Add(selItem.RealPath)
Set oAttachments = oEmailItem.Attachments.Add(CStr(selItem.RealPath))
subjectStr = subjectStr & Right(selItem.RealPath,Len(selItem.RealPath)-(InStrRev(selItem.RealPath,"\"))) & ", "
strText=strText & LineBreak & Right(selItem.RealPath,Len(selItem.RealPath)-(InStrRev(selItem.RealPath,"\")))
End If
Next
End If
DOpus.Output clickData.func.sourcetab.selected(0).RealPath
Set objFSO = CreateObject("Scripting.FileSystemObject")
'below you could change your username and the Outlook signature file name
dim oShell
Set oShell = CreateObject("WScript.Shell")
dim strHomeFolder
strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
'strSigFilePath = "C:\Users\huangb\AppData\Roaming\Microsoft\Signatures"
strSigFilePath = strHomeFolder & "\AppData\Roaming\Microsoft\Signatures"
Set objSignatureFile = objFSO.OpenTextFile(strSigFilePath & "Office - Internal.htm")
strBuffer = objSignatureFile.ReadAll
objSignatureFile.Close
'below you could change the Email Subject Prefix and the Text Prefix
oEmailItem.Subject = "FileSharing: " & Left(subjectStr, len(subjectStr)-2)
oEmailItem.BodyFormat = olFormatHTML
oEmailItem.HTMLBody = "Please check attachment: " & strText & ". " & LineBreak & LineBreak & strBuffer
oEmailItem.Display
End Function
And here's the error message:
Selected items in C:\Users\uksjw602\Desktop:
(f) C:\Users\uksjw602\Desktop\test.txt
C:\Users\uksjw602\Desktop\test.txt
26/02/2019 12:57 Error at line 47, position 1
26/02/2019 12:57 File not found (0x800a0035)
Here's line 47:
Set objSignatureFile = objFSO.OpenTextFile(strSigFilePath & "Office - Internal.htm")
The file Office - Internal.htm definitely exists in the signatures folder, as you can see here:
