アラフィフおやじログ

とりあえず機器とかソフトの情報がまったく整理されていなくて オレのせいにされそうなので、PCViewで情報を採取しつつ台帳整理を あるていど効率化させようと企ててスクリプトを作りました。 本当はスタートアップに仕込んでおけば起動時にデータを取得してって できて便利がいいんだけどまぁ、今勤めているところはなぜか ボタンを押させるというなぞの習慣が好きなのでVBSを起動すれば PCViewで取得した情報が共有フォルダに保管されます。 Const vbHide = 0 'ウィンドウを非表示 Const vbNormalFocus = 1 '通常のウィンドウで、最前面のウィンドウ Const vbMinimizedFocus = 2 '最小化で、最前面のウィンドウ Const vbMaximizedFocus = 3 '最大化で、最前面のウィンドウ Const vbNormalNoFocus = 4 '通常のウィンドウで、最前面ではない Const vbMinimizedNoFocus = 6 '最小化で、最前面にはならない Set objWShell = CreateObject("WScript.Shell") Set FSO = CreateObject("Scripting.FileSystemObject") strCudir = objWShell.CurrentDirectory strPath = "保存先フォルダ" If Not FSO.FolderExists(strPath) Then strPath = strCudir & "\" End If pcViewini = strCudir & "\tool\PCView.ini" If Not FSO.FileExists(pcViewini) Then WScript.Quit End If 'フォルダに接続不可の場合はカレントディレクトリにファイルを保存する。 ForReading = 1 ForWriteing = 2 Set objTextFile...

書込みがあれば読込めとかいう無茶振りもある・・・。 仕方がないので色々と探しました。 まんまパクリですが・・・・・。 とりあえず可変値でも何とか取得できるし、これで値は取れそうです。 後はCSVに吐き出させてそれをEXCELに取込ませるという面倒なことを しないといけない。やめてくれよなぁこういうの 'refer 'https://gallery.technet.microsoft.com/scriptcenter/d9d76585-4338-400e-a7a5-48ad6664f496 'https://stackoverflow.com/questions/18098319/iterate-through-registry-subfolders 'http://www.tek-tips.com/viewthread.cfm?qid=1162228 Const HKEY_LOCAL_MACHINE = &H80000002 strComputer = "." const REG_SZ = 1 const REG_EXPAND_SZ = 2 const REG_BINARY = 3 const REG_DWORD = 4 const REG_MULTI_SZ = 7 '読取りたいキーのパス指定 strOriginalKeyPath = "SOFTWARE\*****" '関数呼出 FindKeyValue(strOriginalKeyPath) '------------------------------------------------------------------------- ' レジストリキーを再帰的に取得する。 '------------------------------------------------------------------------- Function FindKeyValue(strKeyPath) Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_ ...

ちょこっと仕事で作業しているときにかったるくなったので ファイル名置換を一気にしてくれるツールを作成してみた。 というより、ファイル名変更が必要ないようにした方がいいのかも しれないけど、そうすると色々と面倒ごとがあるのでツールの作成を選びました。 といっても手作業が完全排除できないところが悲しい。 ツールについてはjsというのも考えたけど、諸般の事情でVBSに したった。ちなみにinitPathのところをネットワークパスにすると ネットワークの共有フォルダもフォルダ選択できたんでびっくり しょせんへっぽこなのでネットの切り貼りです。 いまだに再帰処理がうまくかけませぬ。 コレぐらいさくっと作れればいいけどなぁ。結局テスト込みで 3時間かかってるよトホホ Option Explicit Option Explicit Dim objShell Dim wsh Dim initPath 'フォルダ指定 initPath = "C:" Dim targetFolder Set objShell = WScript.CreateObject("Shell.Application") If Err.Number = 0 Then Set objFolder = objShell.BrowseForFolder(0, "対象フォルダの選択", 16, initPath) If Not objFolder Is Nothing Then targetFolder = objFolder.Items.Item.Path else WScript.Quit End If Else WScript.Echo "エラー：" & Err.Description End If Dim objFileSys, objFolder, objFile Set objFileSys = WScript.CreateObject("Scripting.FileSystemObject") Set objFolder = objFileSys.GetFolder(target...

国の 法令検索 から条文を引っ張ってきて加工するというスクリプトを 作成すべく、 先に挑戦 していたわけですが・・・、とてもじゃないけど 手が出ない・・・。 構造が解析できないのでうまく取れない。 それに「編」とか「 節」とか「 款」がうまく取れないみたい。 本文もきれるのがあるし使えないけれども、ひとまずのバックアップとして ※特許法とかの知財関連の法案が取れればいいんですけどね・・・。 機能としては 法令検索から条文のソースを引いてきて、EXCELで加工して保存します。 自分で使うのでエラー処理は甘めです。 もし使う場合は自己責任で使ってくださいね。 Googleの仕様が変わると修正が必要です。 もっときれいにできるよとか、うまく改造できる方いらっしゃったら ご指摘いただけると幸いです。 2016/8/19　動かない箇所があったので修正版に置き換えました。 ' ◆参照サイト ' ◆参照サイト ' http://www.kanaya440.com/contents/tips/vbs/007.html ' http://www.takeash.net/wiki/?VBScript ' http://d.hatena.ne.jp/ken3memo/20090903/1251991651 ' http://plaza.rakuten.co.jp/densen/diary/201310200000/ ' http://fanblogs.jp/fjt/archive/58/0 ' http://foundknownanddone.blogspot.jp/2014/05/IE-Internet-Explorer-automation-VBScript-DOM-WSH-waitIE.html ' http://so-zou.jp/software/tech/programming/vba/sample/web.htm ' http://www.koutou-software.net/junk/use-vs-project-with-vbscript.html ' http://vbsguide.seesaa.net/article/144608106...

弁理士関連で法律が年に1回変わるので学習ツールとか 作る際に、条文をダウンロードするのがなぁとおもっていたので その元ネタでサンプル作成してみたよ。 Googleをキーワード検索して一番上にあるやつの 緑タイトルを拾ってそこにアクセスしてページソースをダウンロードする というもの。エラー処理とかないので取扱いは慎重にした方が いいですよ。 で以下、ソース。まさかCITEタグとは思いもしませんでした。 後はダウンロードした後にEXCELに加工して取り込めば楽できるな。 skeywordを他の法律に変えれば別の法律も取得できます。 法令検索 の結果が一番に表示されるなら加工もしやすいかな・・・。 '// '// 特許法のページソースを取得する '// '// Proxy環境の場合はDOSプロンプトで実行 netsh winhttp import proxy source=ie Option Explicit Dim sURI Dim rgetHtml Dim oFilename Dim sKeyword '// メイン部分 sKeyword = "特許法" oFilename = "C:\temp\" + sKeyword +".txt" sURI = getURL(sKeyword) if sURI = False then MsgBox "notComplete" end if rgetHtml = getHTML(sURI,oFilename) if rgetHtml=True then MsgBox "Complete" end if '// Googleでキーワード検索1位のURL(下に緑で出てる▼のやつ)を取得する function getURL(sKeyword) Dim objIE getURL = False Dim rURL Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = False objIE.Na...

さる用事があって Kintone の API を使ってEXCELにデータを 取込みたいと思いまして、VBScriptでサンプル作成してみました。 せっかくなのでメモがてら 動いたときは少し感動しました。 後はこれをEXCELに載せ替えて加工します。 これで基幹系との連携やなんかやりやすくなるかと まぁ、レコード取得だけやけどね。 以下ソース Option Explicit Call ExecCommand Sub ExecCommand() Dim oXML Dim oNode Dim url Dim t Dim appNo Dim idNo Dim cAuthorization Dim kintoneReqjson 'アプリIDとレコードID指定 appNo = XXX 　idNo = XXX 　　'Body用JSON文字列 　　kintoneReqjson = "?app=" & appNo & "&id=" & idNo url ="https://XXX.cybozu.com/k/v1/record.json" &kintoneReqjson cAuthorization = "BASE64エンコードしたID:PW" Set oXML = Nothing '初期化 On Error Resume Next 　　 With CreateObject("MSXML2.XMLHTTP") .Open "GET", url, False .setRequestHeader "X-Cybozu-Authorization", cAuthorization .Send Set oXML = .responseXML t = .responseText End With ...

EXCELに登録するシーンというのが意外と多いので VBScriptでTry,Catch使える方法がないかなぁと。 へっぽこプログラマーなのでエラー処理が多過ぎて、苦痛でした。 まぁスクリプトと割り切ってエラー制御端折るのも手だけどなぁ。 エラー処理は日々是勉強ですな。 Function ExcelSheetInput(val_keyNo,val_Clumn,val_Path) '参照：http://3rd.geocities.jp/kaito_extra/Source/ExcelCtrl.html Dim argRtn(3) '引数チェック用 Dim objExcel Dim xlSheet Dim keyNO ' Dim InputDate ' Dim Clumn ' Dim excelPath ' Dim i 'ループカウンター Dim LastRow 'EXCEL最終行 Dim matchnum '対象EXCEL行数確保用 Dim KeyCell 'Key保管EXCEL行 Dim CellValue 'Key格納用ワーク Dim InputArea '更新行 Dim strEmpCol strEmpCol ="X" 'EXCELの列 Dim objFso 'ファイル存在チェック用 '/* 引数エラーチェック argRtn(0)= argumentChecker(val_keyNo) argRtn(1)= argumentChecker(val_Clumn) argRtn(2)= argumentChecker(val_Path) If argRtn(0) ="False...

それと処理が完了した後でメールが飛ばしたいというのも有ったので メール 送信用スクリプト いろんな人が作っているので今更感があるものの。 念のため保管。Gmailを送信エンジンに使うのもどうかなという気がするけど SSL対応してない某社メールサーバが悪いということで Function CompMailSend(val_keyNo,val_Path) Dim argRtn(2) '引数チェック用 Dim objFso 'ファイル存在チェック用 Dim objExcel Dim xlSheet Dim keyNO Dim excelPath Dim i Dim LastRow Dim matchnum '対象EXCEL行数確保用 Dim KeyCell Dim CellValue Dim strEmpCol strEmpCol ="X" 'EXCEL列 Dim empdateColum 'EXCEL列 empdateColum ="X" Dim InedepColumn 'EXCEL列 InedepColumn ="X" Dim TargetRow '対象行 Dim MailRowValue Dim MailEmpDValue Dim MailindepValue Dim oMsg 'メールオブジェクト Dim strConfigurationField Dim strBodymsg 'メール本文用 Dim mailUser ' Dim mailpas...

EXCELからACCESSに登録する部分。 チェックロジックの中に色々と詰め込む。 何となく気に入らない作りながら仕方がない。 今後、色々と見直しする。 Function ExcelToAccess(val_ExcelPath,val_AccessPath,val_EmpDate) Dim cn, rs 'ACCESSデータベース Dim objExcel 'EXCEL Dim xlSheet Dim objFso 'ファイル存在チェック用 Dim argRtn(3) '引数チェック用 Dim DataBaseName Dim strSQL Dim ExcelName Dim EmpDate '現在日付取得(登録日日算出) Dim keyDate Dim OpFlg Dim i 'ループカウンタ(タイトル行除外スタート) Dim j '処理件数カウント用 Dim LastRow 'EXCELL最終行 Dim KeyCell 'EXCEL行NO(抽出条件ヒット用 Dim KeyOpFlgCell '手動除外用 Dim CellValue '格納用ワーク Dim strEmpCol strEmpCol ="X" 'EXCELの列 Dim strOpCol strOpCol ="XX" 'EXCELの列 Dim rsCount 'レコード件数カウント用 Dim EmpMCclum EmpMCclum = "X" Dim InputArea ...

先ほどのメイン処理にひき続いて、ActiveDirectory登録用のスクリプト ホントは所属するグループもデータベースから引っこ抜いてきて処理させたかったんやけど グループツリーが複雑すぎるんでユーザ追加のみ実装、相変わらずぶさいくなコードです。 メールサーバ登録部分は公開なし。ブラウザ立ち上げて某社さんのツールで登録するという ブラウザ制御のやつなんで、ここでは載せられない・・・。 そういえば、Samba4.0出てきてActiveDirectory使えるようになってるらしい。 実用レベルだとするとActiveDirectoryとファイルサーバをLinuxで構築して CALを削減するということもできそうと感じたりした。 ちょろっと修正したソース。汚いのには代わりはないが・・・ Function ActiveDirectoryAdd(val_Uname,val_UloginID,val_Upassword,val_Email,val_Place) Dim argRtn(5) '引数チェック用 Dim strUserName 'ユーザ名 Dim strLoginID 'WindowsログインID Dim strPassword 'Windowsパスワード Dim strEmailAdd 'Emailアドレス Dim strPlace '事業所 Dim dtStart Dim objConnection Dim objCommand Dim objRecordSet Dim objOU Dim objUser Dim nwErrChk Dim adServName Dim adDc Dim adDomain Dim userFrags adServName = "XXXX" adDc = "CN=users,dc=XXXX,dc=local" adDomain = "XXXX.local" ...

ひとまずACCESSのデータベースから値を拾ってきてActiveDirectoryと外部メールサービスに新規ユーザを追加するVBスクリプトを作ってみた。どこかで再利用するかもしれないから保存しとく。ずぶの素人が作成しているのでソース汚いのはお約束で・・・・ 以下、メインの処理 を  ・EXCELからデータを引いてきて、データを加工しACCESSに登録  ・ACCESSからデータを抜いてADとメールサーバにデータ登録  ・結果をEXCELに登録しつつ、完了メール送信 てな塩梅です。 Option Explicit Dim Logrtn 'Log Dim CErrMsg Dim LErrMsg CErrMsg = "エラー：処理継続不可" LErrMsg = "エラー：ログ出力時エラー" Dim cn, rs 'ACCESSデータベース Dim objFso 'ファイル存在チェック用 Dim DataBaseName Dim strSQL Dim ExcelName Dim EmpDate '現在日付取得 Dim EmpNo Dim rsCount 'レコード件数取得用 Dim strName Dim strKnName Dim strPlace Dim Section Dim EmpLank Dim EmpStat Dim strLoginID 'WindowsログインID Dim strLoginPW 'WindowsログインPW Dim strPMailAdd 'メールアドレス Dim strPMailPW 'メールアドレスパスワード Dim AdColum Dim MailColum AdColum = "X" 'EXCELの列 MailColum = "X" 'EXCELの列 Dim EmpMrtn Dim Adrtn Dim AdGrtn Dim Mlrtn ...