オーバーフォーティーおやじログ

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