LoginSignup
0
0

More than 5 years have passed since last update.

VBScript Outlookのタスク(仕事)にファイルを登録する

Last updated at Posted at 2017-05-16
MakeOutlookTaskformFile.vbs
Const olJournalItem = 4
Const olTaskItem = 3
Const olFolderJournal = 7
Const StoreName = "Mail@Address" 'Change Your mailAddres
Const olSave = 0
Const olDiscard = 1
Const JpnOlJounrnalTypeNameOfEmail = "電子メールメッセージ"
Const JpnOlJounrnalTypeNameOfDocument = "ドキュメント"
Const JpnOlTaskTypeNameOfDocument = "仕事"
Const olTaskNotStarted = 0
Const olTaskInProgress = 1
Dim oApp: Set oApp = CreateObject("Outlook.Application")
Dim NS: Set NS = oApp.GetNamespace("MAPI")
Dim oJfol
Dim objArgs, I, strFile, strFolder
Dim objFile, objFolder, objPath, strScr
Dim strBase, strExt, strParent, strPath, strZip, RetVal
Dim objShell: Set objShell = CreateObject("WScript.Shell")
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim myJItm 'As Outlook.JournalItem
Dim myMItm 'As Outlook.MailItem
Dim blnExist 'As Boolean
Dim oRoot, olStore
Set olStore = oApp.Session.Stores.Item(StoreName)
Set oRoot = oApp.Session.Stores.Item(StoreName).GetRootFolder
Set oJfol = oRoot.folders(JpnOlTaskTypeNameOfDocument)
Set objArgs = Wscript.Arguments

I=0
Set objFile = FSO.GetFile(CStr(objArgs(I)))
strParent = FSO.GetParentFolderName(objFile)
Set objPath = FSO.GetFolder(strParent)
strBase = FSO.GetBaseName(CStr(objArgs(I)))
strExt = FSO.GetExtensionName(CStr(objArgs(I)))
strPath = strParent & "\"
blnExist = False
If blnExist = False Then
msgbox objfile.path
Set myJItm = oApp.CreateItem(olTaskItem)

With myJItm
.Display
.Subject = "<" & "file:///" & replace(objFile.Path,"\","/",1,-1) & ">"
.Body = "CurrentFilePath:= " & strParent & vbCrLf & _
"FileName:= " & objFile.Name & vbCrLf & _
"FolderLink:= " & " <" & "file:///" & replace(strParent,"\","/",1,-1) & ">" & vbCrLf & _
"FileLink:=" & " <" & "file:///" & replace(objFile.Path,"\","/",1,-1) & ">" & vbCrLf & _
"CreationTime:= " & Cdate(FSO.GetFile(CStr(objArgs(I))).DateCreated) & vbCrLf & _
"LastWriteTime:= " & Cdate(FSO.GetFile(CStr(objArgs(I))).DateLastModified)

If LCase(strExt) = "msg" Then
Set myMItm= myJtm
.Body = myJItm.Body & VbCrLf & Left(myMItm.Body, 1000)
.ContactNames = myMItm.SenderName
End If

.Categories = .Categories
.Status = olTaskInProgress
.StartDate = Date() '今日が開始時点
.End = DateAdd("d",30,Date()) ’期限は1か月後
.Save
.Close 1
Wscript.Sleep 1000
End With
Else
End If

Set objShell = Nothing
Set FSO = Nothing
Set NS = Nothing
Set oApp = Nothing
Wscript.Quit

ファイルをドラッグアンドドロップでタスクに登録する

しかもファイルリンクを作成して、タスクからファイルを開けるようにしています。
標準ではタスクの期間を1か月にしています。
StoreName = "Mail@Address" に自分のメールアドレスをいれてください。

ファイル形式の制限

オフィスの主なファイル、PDFにしています。

詳しいオブジェクトの解説

というほどでもありませんが、
OUTLOOK VBA オブジェクトまとめ
があります。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0