' CreateCybozuItem.vbs v0.01 ' Copyright (C) 2007 甘党のプログラマ, All rights reserved. 'v0.01 (2007/10/24) '初版-サイボウズの予定作成のみ対応。 Option Explicit const VBS_TITLE = "CreateCybozuItem.vbs v0.01" Dim strUrlPath, strUrlPage, strUrlId, strUrlGid, strUrlData, strUrlBpage, strUrlBdate Dim strAppActivate strUrlPath = "http://★.★.★.★//scripts/cb3/office.exe" strUrlPage = "page=ScheduleEntry" strUrlId = "id=★" strUrlGid = "gid=★" strAppActivate = "★★★ - スケジュールの登録 - Microsoft Internet Explorer" Dim objWshUnnamed Set objWshUnnamed = WScript.Arguments.Unnamed Dim objWshNamed Set objWshNamed = WScript.Arguments.Named Dim enumItemType (0:olMailItem/1:olAppointmentItem/3:olTaskItem/4:olNoteItem) Dim strItemType Dim strInputFile ' 入力ファイル名 Dim objFso Dim objStream Dim objIE Dim strUrl Dim boolDelFileFlag boolDelFileFlag = False Dim boolContProcFlag boolContProcFlag = True Dim boolFindStat boolFindStat = False Dim oRe, oMatch, oMatches, RetStr Dim idxFindPos Dim strYear ,strMon, strDay Dim strHour, strMin Dim objWSHShell Dim strBody Dim Idx If objWshUnnamed.Count <> 2 Then DispUsage boolContProcFlag = False Else Select Case objWshUnnamed(0) Case "appo" enumItemType = 1 'olAppointmentItem strItemType = "予定" Case Else DispUsage boolContProcFlag = False End Select strInputFile = objWshUnnamed(1) If objWshNamed.Exists("DEL") Then boolDelFileFlag=True If boolContProcFlag = True Then Set objFso = CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strInputFile) Then Set objStream = objFso.OpenTextFile(strInputFile , 1) strBody = objStream.ReadAll() strYear = Year(Now) strMon = Month(Now) strDay = Day(Now) strHour = Hour(Now) If (Minute(Now)<30) Then strMin = 0 Else strMin = 30 End If ' 月/日のパターン Set oRe = New RegExp oRe.Pattern = "([0-9]+)/([0-9]+)" Set oMatches = oRe.Execute(strBody) If oMatches.Count > 0 Then Set oMatch = oMatches(0) strMon = oMatch.SubMatches(0) strDay = oMatch.SubMatches(1) idxFindPos = oMatch.FirstIndex Else idxFindPos = -1 End If ' mm月dd日のパターン oRe.Pattern = "([0-9]+)月 +([0-9]+)日" Set oMatches = oRe.Execute(strBody) If oMatches.Count > 0 Then Set oMatch = oMatches(0) If (oMatch.FirstIndex <idxFindPos) Then strMon = oMatch.SubMatches(0) strDay = oMatch.SubMatches(1) idxFindPos = oMatch.FirstIndex End If Else idxFindPos = -1 End If ' 時:分のパターン oRe.Pattern = "([0-9]+):([0-9]+)" Set oMatches = oRe.Execute(strBody) If oMatches.Count > 0 Then Set oMatch = oMatches(0) strHour = oMatch.SubMatches(0) strMin = oMatch.SubMatches(1) idxFindPos = oMatch.FirstIndex Else idxFindPos = -1 End If ' h時m分のパターン oRe.Pattern = "([0-9]+)時 +([0-9]+)分" Set oMatches = oRe.Execute(strBody) If oMatches.Count > 0 Then Set oMatch = oMatches(0) If (oMatch.FirstIndex <idxFindPos) Then strHour = oMatch.SubMatches(0) strMin = oMatch.SubMatches(1) idxFindPos = oMatch.FirstIndex End If Else idxFindPos = -1 End If ' URLの生成 strUrlData = "date=da." & Year(Now) & "." & Month(Now) & "." & Day(Now) strUrlData = "date=da." & strYear & "." & strMon & "." & strDay strUrlBpage = "bpage=ScheduleDay" strUrlBdate = "bdate=da." & strYear & "." & strMon & "." & strDay strUrl = strUrlPath & "?" & strUrlPage & "&" & strUrlId & "&" & strUrlGid & "&" & strUrlData & "&" & strUrlBpage & "&" & strUrlBdate Set objWSHShell = WScript.CreateObject("WScript.Shell") ' IEのインスタンスを生成 set objIE = WScript.CreateObject("InternetExplorer.Application") With objIE .Visible = True .Navigate(strUrl) Do While .busy Loop Do While .Document.readyState <> "complete" Loop ' ウィンドウの切替 boolFindStat = objWSHShell.AppActivate( strAppActivate ) If boolFindStat = False Then MsgBox("debug cannot find ie window") End If WScript.Sleep 1000 'メモへの入力は、Shift+Tab 9回 objWSHShell.SendKeys "+{TAB}+{TAB}+{TAB}+{TAB}+{TAB}+{TAB}+{TAB}+{TAB}+{TAB}" ' クリップボードの内容をペースト objWSHShell.SendKeys "+{INSERT}" objWSHShell.SendKeys "^{HOME}" '予定(タイトル)の入力は、さらに、Shift+Tab 3回 objWSHShell.SendKeys "+{TAB}+{TAB}+{TAB}" ' クリップボードの内容をペースト objWSHShell.SendKeys "+{INSERT}" '開始時刻の時間は、Shift+Tab 5回 objWSHShell.SendKeys "+{TAB}+{TAB}+{TAB}+{TAB}+{TAB}" '8時以降は、↓をstrHour-7回 If strHour > 7 Then For Idx = 1 To (strHour-7) objWSHShell.SendKeys "{DOWN}" Next Else ' 7時以前は、1回↓のあと、↑を9-strHour回 objWSHShell.SendKeys "{DOWN}" For Idx = 1 To (9-strHour) objWSHShell.SendKeys "{UP}" Next End If '開始時刻の分に、移動(Tab 1回) objWSHShell.SendKeys "{TAB}" '00は、↓1回 For Idx = 1 To (strMin/15)+1 objWSHShell.SendKeys "{DOWN}" Next '終了時刻に移動(Tab 1回) objWSHShell.SendKeys "{TAB}" '終了時刻は、開始の+1時間にしておく、移動(Tab 1回) If (strHour+1) > 7 Then For Idx = 1 To ((strHour+1)-7) objWSHShell.SendKeys "{DOWN}" Next Else ' 7時以前は、1回↓のあと、↑を9-(strHour+1)回 objWSHShell.SendKeys "{DOWN}" For Idx = 1 To (9-(strHour+1)) objWSHShell.SendKeys "{UP}" Next End If '終了時刻の分に、移動(Tab 1回) objWSHShell.SendKeys "{TAB}" '00は、↓1回 For Idx = 1 To (strMin/15)+1 objWSHShell.SendKeys "{DOWN}" Next ' Shift Tabで、終了時刻の時間に戻る objWSHShell.SendKeys "+{TAB}" End With Else ' システムがエラーを出すか? End If End If End If WScript.Quit (1) Private Sub DispUsage MsgBox _ "○ 使用方法" & vbCrLf & _ "wscript.exe CreateCybozuItem.vbs item-type filename " & vbCrLf & _ " item-type=appo" & vbCrLf & _ "○ 機能" & vbCrLf & _ "item-typeに指定されたサイボウズv3のアイテム作成します。" & vbCrLf _ ,, VBS_TITLE End Sub
最新の画像[もっと見る]
※コメント投稿者のブログIDはブログ作成者のみに通知されます