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 オブジェクトまとめ
があります。