'変更パラメータ---------------------------------------------------- strUserNameT = "userid" 'TimelogユーザID strPassWordT = "password" 'Timelogパスワード blCheck = True '投稿前確認機能 ' 使う場合True,使わないならFalse strCmdT = "" 'Timelogコマンド ' 必要に応じて "/s "もしくは"/p "を指定 strTagT = "" 'Timelog後ろに必ず付加するタグ ' 不要なら"" strURLT = "http://api.timelog.jp/new.asp" strText = "" strTextT = "" ' IEを使ってクリップボードへ Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "about:blank" ' クリップボードを取得 strText = IE.Document.parentWindow.clipboardData.getData("text") IE.Quit() Set IE = Nothing Set regEx = New RegExp ' 文字列検索・置換用オブジェクトの作成 regEx.Global = True ' 文字列全体を検索するように指定 ' 特殊文字を全角に変換(テキスト中に"があると誤動作するため) regEx.Pattern = """" strText = regEx.Replace(strText, "”") If blCheck Then Set shell = WScript.CreateObject("WScript.Shell") strText = InputBox("この内容で投稿しますか?","投稿確認",strText) End If If InStr(strText, "@@@")> 2 Then ' Timelog投稿文字列の作成 strMes="" strURL="" strImageURL="" strMes=Trim(Mid(strText, 1, InStr(strText, "@@@") - 1)) strURL=Trim(Left(Trim(Mid(strText,Instr(strText,"@@@") + 3)),InStr(Trim(Mid(strText,Instr(strText,"@@@") + 3)),"@@@") - 1)) If InStr(Trim(Mid(strText,Instr(strText,"@@@") + 3)),"@@@") <> Len(Trim(Mid(strText,Instr(strText,"@@@") + 3))) Then strImageURL=Trim(Mid(Trim(Mid(strText,Instr(strText,"@@@") + 3)),InStr(Trim(Mid(strText,Instr(strText,"@@@") + 3)),"@@@") + 3)) End If strTextT = "/d " & strMes & " " & strURL ' Timelog特殊文字を全角に変換 regEx.Pattern = "@" strTextT = regEx.Replace(strTextT, "@") regEx.Pattern = "\[" strTextT = regEx.Replace(strTextT, "[") regEx.Pattern = "\]" strResult = regEx.Replace(strResult, "]") ' タグの付加 Timelog strTextT = strCmdT & strTextT & strTagT 'Timelog----------------------------------------- ' 新しいメモの投稿(Timelog) Set xmlReq = CreateObject("Microsoft.XMLHTTP") xmlReq.Open "POST", strURLT, False, strUserNameT, strPassWordT xmlReq.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" xmlReq.setRequestHeader "User-Agent", "Clip_Post" ' Timelog Post If Not isnull(strTextT) Then If strTextT <> "" Then On Error Resume Next Set sc = CreateObject("ScriptControl") sc.Language = "Jscript" Set js = sc.CodeObject xmlReq.send("text=" & js.encodeURIComponent(strTextT)) Select Case Err.Number Case 0 'WScript.Echo "OK!^^;" 'テスト用 Case Else WScript.Echo "NG!><;" End Select Else Wscript.Echo "書き込み文がありません!" End If Else Wscript.Echo "書き込み文がありません!" End If Set xmlReq = Nothing Else Wscript.Echo "書き込み文が不正です!" End If