GoogleAdSenseのPINコード

今更書くほどのことでもないんですが、少し前に、GoogleAdSenseという、アフィリエイト広告を始めました。


GoogleAdSenseってなによ！？

簡単に言えば、自分のホームページやブログに他人様の広告を表示して、広告がクリックされたら、回数に応じて収益がもらえるというやつです。

あまり広告収入は期待していませんが、あるとホームページが賑やかになるカナ！？
くらいの感じです。（実際、収入はありません(+o+)）


PINコードが届きました！

昨日、身元確認のためのPINコードなるものが、ようやく届きました。
PINの生成日が"2012/2/8"なので、2週間ほどかかりました。
（収入が一定額にならないと届かないのでは！？と思ってしまいました。）

届いた封書は、A5の紙を半分に折って、左右と下の3か所をシールで止めてあるだけの、
良く言えば、ひじょ～にシンプルなものです。
（紙を丸めると、中が丸見えですが、、、(-_-;)）


中を空けると、PIN：＊＊＊＊＊＊（ぼかし）と書かれています。


という訳で、早速登録してみます。
「PINを入力してください」をクリックして、


「PINコードの入力」⇒「PINを送信」
、、、で、あっさり登録が終わりました。



これで広告をクリックされれば、収入がバンバン入る！？なんて甘いです。
今の所、1クリック／数百ページビュー　位です。
振込がされるのは、お支払い基準額（￥10,000）に達してからという事なので、いったいいつになる事やら、、、

ちなみに、自分でクリックしてはダメです！
もちろん家族や友人に頼むのもダメです！
Googleは、サイトの状況やOS、ブラウザ、解像度など様々な要素から、かなりの精度で、チェックしているらしいです。
ルータの電源入れ直しでIP変えて、とかマンガ喫茶から串を使って、バンバンクリック！
なんてやった日には、2～3日後に、アカウント停止のお達しが届くそうですので、くれぐれも気長に待ちましょう！（やったら犯罪ですから）

、、、ちなみに、自分は、、、クリックしちゃいました∑(*ﾟдﾟ*)!!
でもあくまで確認用に数クリックだけだったので、怒られることはありませんでした。

くれぐれもお気を付け下さい(-。-)y-゜゜゜



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

第3回：FANの異音と処理速度低下PC復旧

さて、本日ご紹介する内容は、とある個人様から、、

【ご依頼内容】
　パソコンを起動すると、時々、異音「カタカタ」がし、日々音が大きくなってきている。
　また、処理速度がとても遅く、インターネットで動画がプツンプツンと切れる。

【お仕事内容】
　パソコンは、Fujitsu FMV BIBLO NF55Y/D WindowsVistaSP1
　

　まずは、不測の事態に備えて、旧HDDのクローンを、新HDDに作ります。
　

　中を見ると、ディスプレイが、何か幕を張ったような感じになっています、、、
　

　キーボードも、なかなかすごい汚れです（ダジャレじゃありません）
　

　まずは、分解します。パネルを外すと、意外にもホコリは少なかったです。
　

　このタイプは、とても分解しやすいです。自社サポート用によく考えてあるんでしょうね。
　（ここまで開けるのに、10分と掛かりません。）
　問題のFanが見えました！（書いていませんでしたが、異音の原因がFanというのは確認済です）
　

　このFanは、エアースプレーで回すと、カラカラと元気な音を立てています。
　まずは、だいぶ汚れていたので、ホコリをきれいにお掃除します。
　（頑固な汚れは、魔法のお薬できれいにしてあげます。）
　そのあと、軸部分にグリースを注入します。すると、、、
　「サァー」と、いい響きに生まれ変わりました♪
　
　表側はこんな感じです。（写真はホコリを取った後です。）
　

　裏側はこんな感じです。（写真はホコリを取った後です。）
　

　中はこんな感じです。（写真はホコリを取った後です。）
　

　あとは、処理速度の低下です。ディスク使用量を見ると、残り2GB！！
　随分使いっぱなしだったんでしょうね。
　お客様から「リカバリして！」とのことなので、リカバリします。
　この辺は省略しますが、やったことは大体こんな感じです。
　・パーティションサイズの変更（Cドライブ拡大）
　・OSのリカバリ
　・ServicePack1とServicePack2の適用
　・WindowsUpdateの適用

　、、、と本当はここまでなのですが、おまけで下記の設定も、お客様宅にて行わせて頂きました。
　・インターネット接続設定
　・メールの設定＆データ復旧
　・プリンタドライバのインストール＆設定

　さらに格安サービス（ほとんどおまけです、、、）
　・ソフトのインストール3本

　ちなみに、パソコンは、ご返却前にピカピカにしておきました。
　FANのメンテより、こちらの方が時間が掛かりました(-_-;)　
　

【作業期間：1日、お会計：￥8,480】
　・初期診断：無料
　・パソコンサポート基本料金：￥980
　・FAN修理：￥2,000
　・OSリカバリ：￥3,000
　・パーティション変更：￥1,000
　・その他もろもろ：￥1,500
　となります。

ご利用ありがとうございました！

最後に
　「パソコンのメンテナンスはどうしたらいいのと？」とよく聞かれます。
　パソコンを長く使うためには、普段の手入れが一番ですが、その中でもホコリは一番の大敵です。
　エラースプレーなどでこまめに掃除してあげましょう！
　でもくれぐれも、中に向かって吹かないようにしてください。逆にホコリを吸い込んじゃいますから。
　不安な方は、いつでもご連絡下さい。

　ちなみに弊社では、お預かりしたパソコンをきれいにしてご返却しています。
　（もちらん無料サービスです。頼まれなくてもやっちゃいます。）
　これは、お客様に、「おっ、自分のパソコンはまだまだ使えるじゃん♪」と思ってほしいからです。
　パソコンは上手に使えば、パソコンは3年～5年位は使えますから(-。-)y-゜゜゜



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

第2回 Windows7/64bit+仮想マシン(VirtualPC)+Ubuntu11.10

前回の続きです。


起動時オプションの変更が必要！

起動時に、「F6」を連打し、メニューが出たら[ESC」を押します。
すると、下の方に起動時オプションが表示されるので、末尾を次のように書き換えます。


変更前："quiet splash --"


変更後："vga=791 noreplace-paravirt"


すると、起動します！
これは、解像度の問題らしいです。でもこれで終わりではありません！
このあと、インストールし、設定を保存しないと、また元の木阿弥、、、


いよいよ、お待ちかね、Ubuntu11.10のインストール！


まずは、デスクトップ「Ubuntu 11.10のインストール」をクリック！


言語は、「日本語」のまま　⇒　続ける


インターネット接続環境なら、次のオプションもチェック（どちらでも構いません）します　⇒　続ける
「インストール中にアップデートをインストールする」
「サードパーティーのソフトウェアをインストールする」


仮想マシンにインストールするので、「ディスクを削除してUbuntuをインストール」をのまま　⇒　続ける
※．すでにインストール済のディスクを使用した場合、ここで、「Windows〇〇がインストールされていますが」的な警告メッセージも出ます。


ここまで来たら「インストール」　⇒　続ける


もう1回「インストール」　⇒　続ける


地域を選びます　⇒　続ける


キーボードレイアウトは、自分に合った環境で　⇒　続ける


次の項目を入力する　⇒　続ける
・「あなたの名前」
・「コンピュータの名前」
・「ユーザ名」⇒　ログインするときの名前
・「パスワード」　⇒　ログインするときのパスワード（忘れないで！）


ここから、インストールが始まります。この設定で、大体30～40分位でした。

再起動しないで！！


ようやくインストールが完了です！
でもここは、再起動せず、「使用を続ける」で続けます。
先に話した設定を保存するためです。



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

続きを読む

第1回 Windows7/64bit+仮想マシン(VirtualPC)+Ubuntu11.10

今回は、タイトル通り、「Windows7/64bit + 仮想マシン（VirtualPC） + Ubuntu11.10」です。



こんなのです↑


Ubuntu11.10のCDを作って、USB起動も作ったら、なぜかUSBは失敗、、、
また母艦をUbuntuで占領されるのは嫌なので、VirtualPCに作ってしまえば！
というわけで、やってみたものの、なぜか失敗、、、
ようやく解決したので、備忘録として残しておきます。

ちなみに仮想マシンについては、こちらを見て下さい。
Ubuntuについては、こちらを見て下さい。
要は、フリーOS「Ubuntu」をCDやUSBメモリに入れておいて、いざという時に備えよう！
という試みです。


1．Ubuntu11.10のCDを作る！

Ubuntu11.10のisoイメージを、こちらからダウンロードして、CDに適当に焼いて下さい。


2．VirtualPCをインストールする！

～割愛～
はい！出来ました！

3．VirtualPC環境を作る！

ここも、ちょー簡単です。
最初に、ベースとなる仮想PCを作ります。


「仮想マシンの作成」をクリックする。


仮想マシンを作成する「名前」と「場所」を指定します。⇒次へ
（何でも構いません。）


当然「はい」です。


「メモリ」を指定します。⇒次へ
（物理メモリを食いますので、無理のない範囲で指定しましょう！）


「容量可変の拡張ハードディスク」の名前と場所を指定します。⇒作成
（既にある方は、既存の仮想ハードディスクでも構いません。）


出来ました！⇒右クリックで設定を開く


先に準備したUbuntuのisoイメージ、あるいはCDの場所を指定しておきます。
（これが無いと始まらない、、、）


ネットワークアダプターは、「共有ネットワーク(NAT)」と物理ネットワークの2つを指定すれば十分かと思います。私の場合、無線なので、「Broadcom…」を選びました。
これで、準備は完了です！


4．いよいよUbuntu11.10のインストール開始！


まずは普通に、仮想マシンをダブルクリックして起動します。


メニューが表示されたら、「インストールせずにUbuntuを試してみる」のままで「Enter」


すると、起動が始まります、、、が！


緑色の画面になって、落ちます。
何べんやっても落ちます。
最初の一回だけデスクトップが表示されたのは、幻だったかと思えるくらいに失敗します。


とりあえず、タスクマネージャ～、プロセス「VPC.exe」を終了します。

長くなったので、続きは次回へ、、、
(-。-)y-゜゜゜



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

パスワードの付け方について

今回は、パスワードの付け方についてです。

パスワードの付け方の基本

一般的に言われている条件は、

・半角英数字と記号を混ぜて、16文字以上
　⇒　8文字以下だと、簡単に解析できますので。

・他人が推測しにくいこと
　⇒　名前や生年月日、ユーザ名と同じものは使わない。

・定期的に変える事
　⇒　情報漏えいや業務担当者の変更など、万が一に備えて。


でもこれで本当に大丈夫！？

大丈夫ではありません。どんなに複雑なパスワードを設定しようとも、
パスワードを見破る方法は、ツールによる解析以外にもあります。
それは、、、ズバリ目視です。（イヤン♪）

意外かもしれませんが、毎日同じ席で、隣の席の同僚が、同じ様に打ち込んでいたら、
嫌でもわかりますよね。
現実に、オフィスの向かいのビルから、盗み見るハッカーも実在するそうです。
ですので、大事なのは、判り難いパスワードを設定するとともに、
パスワードを打ち込んでいるところを、見られないように工夫することも大切です。

また、いくら複雑なパスワードでも、自分がチンタラ打ち込まなければいけないようなパスワードも論外です。それじゃぁ、見て覚えてくれと言っているようなものです。


じゃぁ、どんなパスワードがいいか？

半角英数字を混ぜつつ、2～3秒で打ち込め、なおかつ複雑で、自分には覚えやすいパスワードが良いと思います。

・推測されにくい
・他人には覚えにくい
・自分では覚えやすい＆変えやすい


でも考えるのがめんどくさい！？

例えば文章がいいと思います。

「好きなお店は100均です!」⇒「sukinaomiseha100kindesu!」

如何でしょうか？


最後に

パスワードに対して、無頓着な人が多い気がします。
自分が入力するときもそうですが、他人が入力しているときは、
顔をそらすなどの配慮があると、お互い気持ちよく仕事ができると思います。
これも、ネチケットになるカナ！？
(-。-)y-゜゜゜



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

画面ロックの方法と重要性

今回は、画面ロックについてです。

画面ロックって何？

一言で言えば、自分が席を離れているとき、他人にパソコンを操作されない様に、
パスワードロックを掛けることです。




どんなメリットがあるの？

ズバリ！セキュリティ対策です。
自分のパソコンの中の情報流出を防ぐのはもちろん、データの改ざんを防いだり、
悪意のあるソフトウェアを仕組まれないためにも、非常に有効な手段のひとつです。
（あと、こっそり見ていた〇〇なファイルを、うっかりした隙に、大切な人に見られない様、エチケットを守るためにも役立ちます(-_-;)）


難しくない？

とても簡単です。やり方は2つあります。
一つ目は、席を離れるとき、"Windows + L" キーを押す。
二つ目は、スクリーンセーバを有効にする。


具体的にどうやるの？

一つ目は、、、いいですよね(~_~;)
二つ目は、
　１．画面のプロパティを出します。
　　　出し方はOSのバージョンで若干異なりますが、Windows7の場合、
　　　コントロールパネルの個人設定の中にあるスクリーンセーバーをクリックします。
　２．下図のように、設定します。
　　　「待ち時間」：5分（スクリーンセーバーになるまでの時間です。）
　　　「再開時にログオン画面に戻る」：チェックを入れる。
　　　

以上で設定は終わりです。

あとは、何もせず5分待つか、"Windows + L" キーを押してみましょう！
下図のようなログオン画面が出れば成功です！

＜ようこそ画面を使っている場合＞


＜ようこそ画面を使っていない場合＞

これでもう、デスクトップを再開するには、パスワードを入れるしかありません。
（えっ！？パスワードすら設定していない！？、、、して下さいね）


最後に

なぜ今更こんなことを書いたかというと、知っていても意外と使っている人が少ないからです。
セキュリティ対策をきちんとしている会社であれば、Active Directory のポリシーなどで設定していますが、個人任せの会社が多いのも事実です。
ご家庭では、やっていない人が大多数です。（あくまで自分の経験です。）

なぜか！？

必要性を感じないからだと思います。（知らないだけかもしれませんが、、、）
「俺のパソコン、大したデータ入っていないから大丈夫～♪」
いえいえ、本人が考えている重要な情報と、悪意のある人が考えている重要な情報は、
必ずしも一致しません。
大切なのは、「見せない、出さない、触らせない」という考え方だと思います。

注意一秒、けが一生、、ぜひ一度だけでいいので、設定して下さいね♪
(-。-)y-゜゜゜



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

第2回：再起動を繰り返すPC復旧

さて、本日ご紹介する内容は、とある企業様から、、

【ご依頼内容】
　パソコンは起動するが、拡張オプションメニュー画面が開き、
　セーフモード等のどれを選択しても、Windowsロゴ表示後に勝手に再起動してしまう。
　データだけでも救出して欲しい。

【お仕事内容】
　まずは、不測の事態に備えて、旧HDDのクローンを、新HDDに作ります。

　次に、再起動を繰り返すということで、早速確認、、、



　一瞬、ブルースクリーンになるが、すぐに再起動。
　ならばと、動画でキャプチャを撮ったところ、"UNMOUNTABLE_BOOT_VOLUME"の文字が、、、
　

　明らかにHDDの故障です。
　続いて、エラーチェックを行なうと、やっぱり出ました。
　

　エラー内容は、"S・M・A・R・Tエラー"です。
　

　別のツールでも確認＆修復（できれば）
　ちなみに、HDDのエラーは、6割近くが磁性エラーらしい。
　なので、Windows標準機能では回復できないこのツールで、
　エラーも回復してくれることをお祈りしつつ、
　待つこと約3時間、、、(*´ρ`*)　（ウソです。ちゃんと別の仕事をしています）　
　、、、結果、不良セクタの回復ならずです。
　念のため、起動テストしますが、状況は変わりません。（あたりまえですが）
　

　ちなみに、念のため、メモリーもテストしておきます。
　待つこと約2.5時間、、、(*´ρ`*)　（ウソです。ちゃんと別の仕事をしています）
　こちらは、特に問題ありません。
　

　というわけで、次に、旧HDDを魔法のツールに掛けます。（こちらは企業秘密♪）
　待つこと約？時間、、、(*´ρ`*)　（本当です。もう夜中なので寝てました）
　見事、起動できるようになりました！
　（出来なければ、OSリカバリになりますが、今回はリカバリメディアもリカバリ領域も
　　なかったので、良かったです）
　
　
　ここまで来れば、ゴールは目前、、、
　再度、旧HDDのクローンを、新HDDに作り、PCにセットします。
　当然、起動しますが、作業はまだ終わりません。
　念のため、12時間連続稼働テストを行ない、問題が無いことを確認します。
　最後に、旧HDDのデータをすべて、新HDDの空領域にコピーして完了です。

【作業期間：1日、お会計：￥16,440】
　・初期診断：無料
　・旧HDDより復旧：￥3,980
　・HDD交換：￥1,980
　・データ復旧：￥1,980
　・部品代：HDD：￥8,500
　となります。

ご利用ありがとうございました！

最後に
　Windowsが起動しない、すぐにシャットダウンしてしまうなど、HDDエラーが疑われる場合、
　無理に何度も電源を入れると、データ復旧が困難になります。
　そんな時は、すぐにご連絡下さい。
　早ければ早いほど、データ復旧率が上がりますので　(-。-)y-゜゜゜



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

旧ホームページ（tyuta's room）合併完了

ようやく旧ホームページ（tyuta's room）の主だったコンテンツのお引越し完了！ヾ(＠⌒▽⌒＠)ﾉ
（あまり多くは無かったのですが、、、）

それでも、あちらを整理したときは、長年使っていた場所なので、
ちょっぴりさみしい気もします。でも、

心機一転、頑張っていきます

ので、今後もどうぞよろしくお願いいたします。


なお、旧ホームページでのみ公開していたソフトやサンプルソースなどは、
移行できませんでした。
もし必要という方は、こちら（[e-mail]）までご連絡下さい。



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

メール送信（Windows標準のCDOオブジェクトを利用）について

メール送信（Windows標準のCDOオブジェクトを利用）

CDO(Microsoft Collaboration Data Objects)を利用したメールの送信方法についてです。
CDOの参照設定を行ったほうが，より使い易くなりますが，あえて環境に依存しない方法で
作成しました。この方法だとVB以外にも，Excel（VBA）やWSH（VBScript）でも使用できます。

下記の説明でうまくいかない場合は、サンプルをお試しください。
⇒　って、これもブログにサンプルを移植できませんでした。m(__)m

#Region "■■■　定数宣言　■■■"

　　'--------------------------------------------------
　　' CDO関連の定数
　　'--------------------------------------------------

　　Private Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
　　Private Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
　　Private Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
　　Private Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
　　Private Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
　　Private Const cdoSendUsingPort = 2
　　Private Const cdoAnonymous = 0
　　Private Const cdoBasic = 1
　　Private Const cdoNTLM = 2
　　Private Const cdoShift_JIS = "shift-jis"
　　Private Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
　　Private Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"

#End Region


#Region "■■■　変数宣言　■■■"

　　'--------------------------------------------------
　　' Mail関連
　　'--------------------------------------------------

　　Public Structure objMail
　　　　Public objFrom As String 　　　　　　'差出人
　　　　Public objSMTPServer As String　　　 'SMTPサーバ
　　　　Public objSMTP_FLG As Boolean　　　　'SMTPサーバ認証
　　　　Public objUserName As String　　　　 'SMTPサーバ認証：ユーザ名
　　　　Public objPassWord As String　　　　 'SMTPサーバ認証：パスワード
　　　　Public objTo As String 　　　　　　　'宛先（複数指定はセミコロン(;)区切りで指定可）
　　　　Public objCC As String 　　　　　　　'CC（複数指定はセミコロン(;)区切りで指定可）
　　　　Public objBCC As String　　　　　　　'BCC（複数指定はセミコロン(;)区切りで指定可）
　　　　Public objSubject As String　　　　　'件名
　　　　Public objBody As String 　　　　　　'本文
　　　　Public objAttachment() As String 　　'添付ファイル
　　End Structure

#End Region


#Region "■■■　関数　■■■"
　　'==============================================================================
　　'
　　' メール送信
　　'
　　' ------------------------------------------------------------------------
　　' 説明 : メールオブジェクトの内容にしたがってメールを送信する
　　'
　　' ------------------------------------------------------------------------
　　' 引数 : objMailSet　　　　　メールオブジェクトセット
　　'　　　　strErrMsg　　　　　 エラーメッセージ
　　' 戻値 : True:成功、False:失敗
　　'
　　'==============================================================================

　　Public Function fncMailSend(ByVal objMailSet As objMail, _
　　　　　　　　　　　　　　　　Optional ByRef strErrMsg As String = "") As Boolean

　　　　Dim oMsg As Object
　　　　Dim intCnt As Integer

　　　　Try

　　　　　　'--------------------------------------------------
　　　　　　' メール送信
　　　　　　'--------------------------------------------------

　　　　　　'CDOオブジェクト作成
　　　　　　oMsg = CreateObject("CDO.Message")

　　　　　　'CDOオブジェクト設定＆送信
　　　　　　With oMsg
　　　　　　　　'差出人
　　　　　　　　.From = objMailSet.objFrom

　　　　　　　　'宛先，件名，本文設定
　　　　　　　　.To = objMailSet.objTo
　　　　　　　　.CC = objMailSet.objCC
　　　　　　　　.BCC = objMailSet.objBCC
　　　　　　　　.Subject = objMailSet.objSubject
　　　　　　　　.TextBody = objMailSet.objBody

　　　　　　　　'添付ファイル設定
　　　　　　　　For intCnt = 0 To objMailSet.objAttachment.GetUpperBound(0)
　　　　　　　　　　If objMailSet.objAttachment(intCnt).ToString <> "" Then
　　　　　　　　　　　　.AddAttachment(objMailSet.objAttachment(intCnt).ToString)
　　　　　　　　　　End If
　　　　　　　　Next

　　　　　　　　'SMTPサーバ設定
　　　　　　　　If objMailSet.objSMTPServer <> "" Then
　　　　　　　　　　With .Configuration.Fields

　　　　　　　　　　　　'SMTPサーバ
　　　　　　　　　　　　.Item(cdoSendUsingMethod) = cdoSendUsingPort
　　　　　　　　　　　　.Item(cdoSMTPServer) = objMailSet.objSMTPServer
　　　　　　　　　　　　.Item(cdoSMTPServerPort) = 25

　　　　　　　　　　　　'SMTP認証
　　　　　　　　　　　　If objMailSet.objSMTP_FLG Then
　　　　　　　　　　　　　　.Item(cdoSMTPAuthenticate) = cdoAnonymous
　　　　　　　　　　　　　　.Item(cdoSendUserName) = objMailSet.objUserName
　　　　　　　　　　　　　　.Item(cdoSendPassword) = objMailSet.objPassWord
　　　　　　　　　　　　End If

　　　　　　　　　　　　'設定更新
　　　　　　　　　　　　.Update()
　　　　　　　　　　End With
　　　　　　　　End If

　　　　　　　　'メール送信
　　　　　　　　.Send()

　　　　　　End With

　　　　　　'CDOオブジェクト解放
　　　　　　oMsg = Nothing


　　　　　　'--------------------------------------------------
　　　　　　' 戻り値設定
　　　　　　'--------------------------------------------------

　　　　　　Return True

　　　　Catch ex As Exception

　　　　　　'--------------------------------------------------
　　　　　　' エラーメッセージ設定
　　　　　　'--------------------------------------------------

　　　　　　strErrMsg = "メール送信中にエラーが発生しました。" & vbCrLf & _
　　　　　　　　　　　　"ネットワーク管理者（プロバイダ）にお問い合わせください。" & vbCrLf & _
　　　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　　　ex.Message


　　　　　　'--------------------------------------------------
　　　　　　' 戻り値設定
　　　　　　'--------------------------------------------------

　　　　　　Return False

　　　　End Try

　　End Function
#End Region



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

ファイル圧縮（コマンドプロンプト実行）について

ファイル圧縮（コマンドプロンプト実行）

指定したファイルを圧縮（Windows標準のCAB形式）します。
実際には、fncProcRunという関数がプロセスを実行しています。
（この関数については、プロセス実行（アプリケーションの実行）を参照して下さい。）

Windows標準のCab形式で圧縮するため、特にアーカイバなど外部DLLなどは不要でできるので、フリーソフトを利用できない環境（サーバとか）でもファイル圧縮が可能です。ただ、あまり高級な設定はできませんが、、、
またこのやり方は、コマンドプロンプトを実行しているので、コマンド作成部分を引数にすれば、圧縮("MakeCab"コマンド)に限らず、様々なコマンドを実行したい場合に利用できます。

'==============================================================================
'
' ファイル圧縮
'
' ------------------------------------------------------------------------
' 説明 : 指定したファイルを圧縮（CAB形式）する
'
' ------------------------------------------------------------------------
' 引数 : strSourceFile　　 圧縮元ファイル名（フルパス）
'　　　　strCabFile　　　　圧縮先ファイル名（フルパス）
'　　　　blnCreateNoWindow ウィンドウ表示
'　　　　strErrMsg　　　　 エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncCabMake(ByVal strSourceFile As String, ByVal strSourceFile As String, _
　　　　　　　　　　　　　　　　ByVal blnCreateNoWindow As Boolean, ByRef strErrMsg As String) As Boolean
　　Dim strMakeCabCmd As String
　　Dim intRet As Integer
　　Dim strRet As String = ""
　　Dim strOldCabPath As String = ""
　　Dim strNewCabPath As String = ""

　　Try

　　　　'--------------------------------------------------
　　　　' コマンド作成
　　　　'--------------------------------------------------

　　　　strMakeCabCmd = "makecab """ & strSourceFile & """ """ & strCabFile & """"


　　　　'--------------------------------------------------
　　　　' コマンド実行
　　　　'--------------------------------------------------

　　　　'コマンド実行
　　　　intRet = fncProcRun(System.Environment.GetEnvironmentVariable("ComSpec"), _
　　　　　　　　　"/c " & strMakeCabCmd, blnCreateNoWindow, _
　　　　　　　　　True, "", "", "", strErrMsg)


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　If intRet = 0 Then
　　　　　　'正常終了
　　　　　　Return True

　　　　Else
　　　　　　'エラーメッセージ設定
　　　　　　strErrMsg = "ファイルの圧縮処理に失敗しました。" & vbCrLf & _
　　　　　　　　　　　　"ファイル：" & strSourceFile & _
　　　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　　　"--------------------------------------------------" & vbCrLf & _
　　　　　　　　　　　　strErrMsg

　　　　　　　'異常終了
　　　　　　　Return False
　　　　End If

　　Catch ex As Exception

　　　　'--------------------------------------------------
　　　　' エラーメッセージ設定
　　　　'--------------------------------------------------

　　　　strErrMsg = "ファイルの圧縮中にエラーが発生しました。" & vbCrLf & _
　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　"--------------------------------------------------" & vbCrLf & _
　　　　　　　　　　ex.Message


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return False

　　End Try

End Function



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

プロセス削除について

プロセス削除

指定したプロセスを削除します。
このやり方は、プロセス名をキーに、該当するプロセスを削除します。
同じプロセス名が複数存在する場合、すべて削除します。

なお、プロセス名やその他詳細は、"System.Diagnostics.Process.GetProcesses()"で取得できます。やり方は、Sampleを見てくださいね。
⇒って、サンプルはブログに移植できませんでした。m(__)m

'==============================================================================
'
' プロセス削除
'
' ------------------------------------------------------------------------
' 説明 : 指定したプロセスを削除する
'
' ------------------------------------------------------------------------
' 引数 : strProcessName　　　プロセス名
'　　　　strErrMsg　　　　　 エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncProcRun(ByVal strProcessName As String, _
　　　　　　　　　　　　　　　　Optional ByRef strErrMsg As String = "") As Boolean
　　Dim proKillProcess As System.Diagnostics.Process = Nothing
　　Dim proSerchProcess() As Process = Nothing
　　Dim proFindProcess As Process = Nothing


　　Try

　　　　'--------------------------------------------------
　　　　' 対象プロセスをセット
　　　　'--------------------------------------------------

　　　　proSerchProcess = System.Diagnostics.Process.GetProcessesByName(strProcessName)


　　　　'--------------------------------------------------
　　　　' 対象プロセスを削除
　　　　'--------------------------------------------------

　　　　'対象プロセスのプロセスを検索
　　　　For Each proFindProcess In proSerchProcess
　　　　　　'対象プロセスのプロセスＩＤを取得
　　　　　　proKillProcess = System.Diagnostics.Process.GetProcessById(proFindProcess.Id)

　　　　　　'対象プロセスを強制終了
　　　　　　proKillProcess.Kill()
　　　　　　proKillProcess.Dispose()
　　　　Next


　　　　'--------------------------------------------------
　　　　' プロセス解放
　　　　'--------------------------------------------------

　　　　proSerchProcess = Nothing
　　　　proFindProcess = Nothing


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return True

　　Catch ex As Exception

　　　　'--------------------------------------------------
　　　　' エラーメッセージ設定
　　　　'--------------------------------------------------

　　　　strErrMsg = "プロセス削除中にエラーが発生しました。" & vbCrLf & _
　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　"--------------------------------------------------" & vbCrLf & _
　　　　　　　　　　ex.Message


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return False

　　End Try

End Function



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

プロセス実行（アプリケーションの実行）について

プロセス実行（アプリケーションの実行）

指定したプログラムを実行します。
プログラムの引数やウィンドウ表示（コマンドプロンプトは効きますが、アプリケーションがサポートしていなければ効きません。まぁ、オマケです。）、キャンセルの受付なども指定できます。
このやり方は、いろいろありこれが正しいとは思いませんが、引数の組み合わせでなかなかうまくいかず、私の要望に合うやり方が以下のやり方でした。まだまだ、改良の余地があるような、、、いや、絶対ある！

ちなみに、変数宣言とプロパティは、キャンセル処理受付用です。キャンセル処理を行なわないのであれば、不要です。また、サンプルでは、処理経過時間の取得や、プロセスの出力取得（コメントしてありますが）も追加してあります。

#Region "■■■　変数宣言　■■■"

　　'--------------------------------------------------
　　' プロセス関連
　　'--------------------------------------------------

　　Private mblnProcCancel As Boolean = False

#End Region


#Region "■■■　プロパティ　■■■"

　　'==============================================================================
　　'
　　' プロセスキャンセル
　　'
　　'==============================================================================

　　Public Property ProcCancel() As Boolean
　　　　Get
　　　　　　Return mblnProcCancel
　　　　End Get
　　　　Set(ByVal value As Boolean)
　　　　　　mblnProcCancel = value
　　　　End Set
　　End Property

#End Region


#Region "■■■　関数　■■■"
　　'==============================================================================
　　'
　　' プロセス実行
　　'
　　' ------------------------------------------------------------------------
　　' 説明 : プロセスを実行する
　　'
　　' ------------------------------------------------------------------------
　　' 引数 : strCMD　　　　　　　実行プログラム
　　'　　　　strPara　 　　　　　引数
　　'　　　　blnCreateNoWindow 　ウィンドウ表示
　　'　　　　blnCancel 　　　　　キャンセル処理受付
　　'　　　　strErrMsg　　　　　 エラーメッセージ
　　' 戻値 : プロセス終了コード
　　'
　　'==============================================================================

　　Public Function fncProcRun(ByVal strCMD As String, ByVal strPara As String, _
　　　　　　　　　　　　　　　　ByVal blnCreateNoWindow As Boolean, ByVal blnCancel As Boolean, _
　　　　　　　　　　　　　　　　Optional ByRef strErrMsg As String = "") As Integer

　　　　Dim proMainProcess As System.Diagnostics.Process = Nothing
　　　　Dim proMainProcessInfo As New System.Diagnostics.ProcessStartInfo
　　　　Dim intExitCode As Integer
　　　　Dim proKillProcess As System.Diagnostics.Process = Nothing

　　　　Try

　　　　　　'--------------------------------------------------
　　　　　　' プロセス準備
　　　　　　'--------------------------------------------------

　　　　　　 With proMainProcessInfo
　　　　　　　　　.FileName = strCMD
　　　　　　　　　.Arguments = strPara
　　　　　　　　　.UseShellExecute = False
　　　　　　　　　.CreateNoWindow = Not blnCreateNoWindow 'ウィンドウ表示
　　　　　　End With


　　　　　　'--------------------------------------------------
　　　　　　' プロセス監視
　　　　　　'--------------------------------------------------

　　　　　　If Not blnCancel Then
　　　　　　　　'プロセス終了まで待機
　　　　　　　　proMainProcess.WaitForExit()
　　　　　　Else
　　　　　　　　'プロセスキャンセルフラグ：Ｔｒｕｅまで処理する。
　　　　　　　　Do Until Me.ProcCancel

　　　　　　　　　　'DoEvent（キャンセル処理を受け付ける）
　　　　　　　　　　Application.DoEvents()

　　　　　　　　　　'プロセスが終了したら、プロセスフラグ：Ｔｒｕｅ
　　　　　　　　　　If proMainProcess.HasExited Then
　　　　　　　　　　　　Exit Do
　　　　　　　　　　End If
　　　　　　　　Loop

　　　　　　　　'プロセスが終了しているかチェック（キャンセルした場合、終了していないので強制終了する）
　　　　　　　　If Not proMainProcess.HasExited Then
　　　　　　　　　　'強制終了
　　　　　　　　　　proMainProcess.Kill()
　　　　　　　　　　proMainProcess.Dispose()
　　　　　　　　End If
　　　　　　End If

　　　　　　'プロセス終了取得
　　　　　　intExitCode = proMainProcess.ExitCode

　　　　　　'プロセス解放
　　　　　　proMainProcess.Close()
　　　　　　proMainProcess.Dispose()

　　　　　　'終了
　　　　　　Return intExitCode

　　　　Catch ex As Exception

　　　　　　'--------------------------------------------------
　　　　　　' エラーメッセージ設定
　　　　　　'--------------------------------------------------

　　　　　　strErrMsg = "プログラムの実行に失敗しました。" & vbCrLf & _
　　　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　　　"--------------------------------------------------" & vbCrLf & _
　　　　　　　　　　　　"実行プログラム：" & strCMD & vbCrLf & _
　　　　　　　　　　　　"引数：" & strPara & vbCrLf & _
　　　　　　　　　　　　ex.Message


　　　　　　'--------------------------------------------------
　　　　　　' 戻り値設定
　　　　　　'--------------------------------------------------

　　　　　　Return 9

　　　　End Try

　　End Function
#End Region



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

数値型チェックについて

数値型チェック

指定した値が、範囲内の数値かチェックします。
ついでに半角チェックもします。このとき、sjisエンコードしてバイトチェックします。
このあたり、VBより楽になった気がします。
ただ、最小・大値のチェックについては、改良の余地があるような、、、

'==============================================================================
'
' 数値型チェック
'
' ------------------------------------------------------------------------
' 説明 : 指定した値が、範囲内の数値かチェックする
'
' ------------------------------------------------------------------------
' 引数 : strNum 　　　　チェックする値
' 　　　 dblMinValue 　　最小値
' 　　　 dblMaxValue 　　最大値
' 　　 　strErrMsg 　　　エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncNumChk(ByVal strNum As String, ByVal dblMinValue As Double, _
ByVal dblMaxValue As Double, Optional ByRef strErrMsg As String = "") As Boolean
　　Dim sjisEnc As System.Text.Encoding = System.Text.Encoding.GetEncoding("Shift_JIS") 'Shift_JISエンコード用

　　Try

　　　　'--------------------------------------------------
　　　　' 数値型チェック
　　　　'--------------------------------------------------

　　　　'入力済チェック
　　　　If strNum = "" Then
　　　　　　strErrMsg = "数値が入力されていません。"
　　　　　　Return False
　　　　End If

　　　　'全角・半角チェック
　　　　If sjisEnc.GetByteCount(strNum) <> strNum.Length Then
　　　　　　strErrMsg = "半角文字ではありません。"
　　　　　　Return False
　　　　End If

　　　　'数値型チェック
　　　　If Not IsNumeric(strNum) Then
　　　　　　strErrMsg = "数値型ではありません。"
　　　　　　Return False
　　　　End If

　　　　'範囲チェック
　　　　If CDbl(strNum) < dblMinValue Or dblMaxValue < CDbl(strNum) Then
　　　　　　strErrMsg = "範囲内ではありません。"
　　　　　　Return False
　　　　End If


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return True


　　Catch ex As Exception

　　　　'--------------------------------------------------
　　　　' エラーメッセージ作成
　　　　'--------------------------------------------------

　　　　strErrMsg = "数値型チェック中にエラーが発生しました。" & vbCrLf & _
　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　"----------------------------------------------------------------------" & vbCrLf & _
　　　　　　　　　　ex.Message


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return False

　　End Try

End Function



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

サブフォルダをすべて削除について

サブフォルダをすべて削除

指定したフォルダ内のサブフォルダをすべて削除します。
削除する検索パターン（*：任意の文字列、?：任意の一文字）も指定できます。

'==============================================================================
'
' サブフォルダをすべて削除
'
' ------------------------------------------------------------------------
' 説明 : 指定したフォルダ内のサブフォルダをすべて削除する。
'
' ------------------------------------------------------------------------
' 引数 : strFolderPath フォルダのフルパス
' 　　 　strPattern 　　検索パターン
' 　　 　strErrMsg 　　エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFoldersDelete(ByVal strFolderPath As String, Optional ByVal strPattern As String = "*", Optional ByRef strErrMsg As String = "") As Boolean
　　Dim strFolders As String() = System.IO.Directory.GetDirectories(strFolderPath, strPattern, System.IO.SearchOption.AllDirectories)
　　Dim intCnt As Integer

　　Try

　　　　'------------------------------------------
　　　　' サブフォルダをすべて削除
　　　　'------------------------------------------

　　　　For intCnt = 0 To strFolders.GetUpperBound(0)
　　　　　　If System.IO.Directory.Exists(strFolders(intCnt)) Then
　　　　　　　　System.IO.Directory.Delete(strFolders(intCnt))
　　　　　　End If
　　　　Next


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return True


　　Catch ex As Exception

　　　　'--------------------------------------------------
　　　　' エラーメッセージ作成
　　　　'--------------------------------------------------

　　　　strErrMsg = "フォルダを削除できませんでした。" & vbCrLf & _
　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　"----------------------------------------------------------------------" & vbCrLf & _
　　　　　　　　　　ex.Message


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return False

　　End Try

End Function



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

フォルダ内のファイルをすべて削除について

フォルダ内のファイルをすべて削除

指定したフォルダ内のファイルをすべて削除します。
削除する拡張子も指定できます。

'==============================================================================
'
' フォルダ内のファイルをすべて削除
'
' ------------------------------------------------------------------------
' 説明 : 指定したフォルダ内のファイルをすべて削除する。
'
' ------------------------------------------------------------------------
' 引数 : strFolderPath フォルダのフルパス
' 　　 　strDelimiter 拡張子
' 　　 　strErrMsg 　エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFilesDelete(ByVal strFolderPath As String, Optional ByVal strDelimiter As String = "*", Optional ByRef strErrMsg As String = "") As Boolean
　　Dim strFiles As String() = System.IO.Directory.GetFiles(strFolderPath, strDelimiter, 　　　　System.IO.SearchOption.AllDirectories)
　　Dim intCnt As Integer

　　Try

　　　　'------------------------------------------
　　　　' 指定したファイルをすべて削除
　　　　'------------------------------------------

　　　　For intCnt = 0 To strFiles.GetUpperBound(0)
　　　　　　If System.IO.File.Exists(strFiles(intCnt)) Then
　　　　　　　　System.IO.File.Delete(strFiles(intCnt))
　　　　　　End If
　　　　Next


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return True


　　Catch ex As Exception

　　　　'--------------------------------------------------
　　　　' エラーメッセージ作成
　　　　'--------------------------------------------------

　　　　strErrMsg = "ファイルを削除できませんでした。" & vbCrLf & _
　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　"----------------------------------------------------------------------" & vbCrLf & _
　　　　　　　　　　ex.Message


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return False

　　End Try

End Function



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

フォルダ削除について

フォルダ削除

指定したフォルダを削除します。
ただし、削除するフォルダが空で無い場合、エラーになります。

'==============================================================================
'
' フォルダ削除
'
' ------------------------------------------------------------------------
' 説明 : 指定したフォルダを削除する。
'
' ------------------------------------------------------------------------
' 引数 : strFolderPath フォルダのフルパス
' 　　 　strErrMsg 　エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFolderDelete(ByVal strFolderPath As String, Optional ByRef strErrMsg As String = "") As Boolean

　　Try

　　　　'------------------------------------------
　　　　' フォルダ削除
　　　　'------------------------------------------

　　　　If System.IO.Directory.Exists(strFolderPath) Then
　　　　　　System.IO.Directory.Delete(strFolderPath)
　　　　End If


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return True


　　Catch ex As Exception

　　　　'--------------------------------------------------
　　　　' エラーメッセージ作成
　　　　'--------------------------------------------------

　　　　strErrMsg = "フォルダを削除できませんでした。" & vbCrLf & _
　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　"----------------------------------------------------------------------" & vbCrLf & _
　　　　　　　　　　ex.Message


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return False

　　End Try

End Function



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

第1回：プリンタ設定＆パソコン教室（ワンポイント講座）

ブログに書きたいことは、毎日山のようにありますが、
なかなか更新できないです(-_-;)
まぁ、ブログ名の通りなので、更新は気ままにいきますが。

さて今日から、弊社のお仕事内容を少しずつご紹介していきたいと思います。
これを読んでいただいて、少しでも弊社の仕事の様子をわかってもらえたらと思います。

第1回目は、、、

【ご依頼内容】
　ノートPC（Toshiba）と、モバイルルータ（Docomoの「Xi（クロッシィ）」）を繋げたい。

【お仕事内容】
　今までも別の無線に繋いでいたという事だったので、設定すればサクッと終わると思いきや
　ネットワーク接続を見ても、どこにも「ワイヤレス ネットワーク接続」がありません！
　よくよく聞いてみると、今までは、別のモバイル用アダプタを使って接続していたようです。
　デバイスマネージャで確認してみると、確かにワイヤレスネットワークがありません！

　（下図は自分のPCの場合です。赤枠が無線LANが搭載されている場合です。）
　

　しかし、HPでハードウェア仕様を見ると、確かに無線LAN「IEEE802.11a/b/g/n準拠」が搭載と
　記載されています。そこで東芝サポートに電話したところ、「オプションです」と、、、
　つまり、無線LANが搭載されていない機種でした。

　では、無線子機を買足して繋げるか？どうかお聞きしたところ、あまり使わないPCなので不要と、、、
　（ちなみに、無線子機は、これがあれば、無線LANに接続できるようになります。
　　価格は、安いもので \1,000～あります。）

　替わりにメインPCがプリンタを使えるようになればよいという事だったので、
　ご依頼内容をプリンタ設定に変更、こちらはサクッと無事に終わりました。

　もうひとつ、こちらはパソコン教室ワンポイント講座です。
　今回は、アメーバブログのことでした。
　最近始められたとのことで、リンクの貼り方や、ペタの付け方など、いろいろでした。

【という訳で】
　今回は、ご依頼内容が随分変更になりましたが、こういう時でも成功報酬なので、
　・プリンタ設定：\1,980
　・ワンポイント講座：\1,980
　となります。

ご利用ありがとうございました！


ところで！！
　お仕事内容とは関係ありませんが、今回のお客様は、なんと「占い師」の方でした！
　占い師名を、「愛月日奈子」さんと言います。
　何年も修行して、占い師になり、今では「月の館」」という著名な占い・鑑定・セラピーのプロ集団で
　ご活躍されている方で、得意は、四柱推命、タロット鑑定だそうです。

　私は、元来占いをあまり気にしない方ですが、この方なら悩んだ時に占ってもらおうと思える、
　しっかりした包容力のある方でした。
　皆さんも、人生に悩んだときは、占ってもらうのも、如何でしょうか！

　※．予め、お客様に許可を頂いて掲載しています。


最後に

この仕事をしていると、色々な職業の方に出会います。
出張訪問の隠れた楽しみでもあるので、ついつい話が脱線することがよくあります。
気を付けねば、、、ゞ(￣∇￣;)




【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

ファイル削除について

ファイル削除

指定したファイルを削除します。


'==============================================================================
'
' ファイル削除
'
' ------------------------------------------------------------------------
' 説明 : 指定したファイルを削除する。
'
' ------------------------------------------------------------------------
' 引数 : strFilePath ファイルのフルパス
' 　　 　strErrMsg 　エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFileDelete(ByVal strFilePath As String, Optional ByRef strErrMsg As String = "") As Boolean

　　Try

　　　　'------------------------------------------
　　　　' ファイル削除
　　　　'------------------------------------------

　　　　If System.IO.File.Exists(strFilePath) Then
　　　　　　System.IO.File.Delete(strFilePath)
　　　　End If


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return True


　　Catch ex As Exception

　　　　'--------------------------------------------------
　　　　' エラーメッセージ作成
　　　　'--------------------------------------------------

　　　　strErrMsg = "ファイルを削除できませんでした。" & vbCrLf & _
　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　"----------------------------------------------------------------------" & vbCrLf & _
　　　　　　　　　　ex.Message


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return False

　　End Try

End Function



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

フォルダ作成について

フォルダ作成

指定したパスに、新たにフォルダを作成します。


'==============================================================================
'
' フォルダ作成
'
' ------------------------------------------------------------------------
' 説明 : 指定したフォルダを作成する。
'
' ------------------------------------------------------------------------
' 引数 : strFolderPath フォルダのフルパス
' 　　 　strErrMsg 　エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFolderCreate(ByVal strFolderPath As String, Optional ByRef strErrMsg As String = "") As Boolean

　　Try

　　　　'------------------------------------------
　　　　' フォルダ作成
　　　　'------------------------------------------

　　　　If Not System.IO.Directory.Exists(strFolderPath) Then
　　　　　　System.IO.Directory.CreateDirectory(strFolderPath)
　　　　End If


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return True


　　Catch ex As Exception

　　　　'--------------------------------------------------
　　　　' エラーメッセージ作成
　　　　'--------------------------------------------------

　　　　strErrMsg = "フォルダを作成できませんでした。" & vbCrLf & _
　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　"----------------------------------------------------------------------" & vbCrLf & _
　　　　　　　　　　ex.Message


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return False

　　End Try

End Function



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

ファイル作成について

ファイル作成

指定した内容をファイルに出力します。
出力内容が比較的少ないログ出力などは、この関数一回で処理が済みます。
逆に、順次出力や追記、出力内容が大きい場合には向きません。あしからず。。。


Imports System.IO
Imports System.Text


'==============================================================================
'
' ファイル作成
'
' ------------------------------------------------------------------------
' 説明 : 指定したファイルを、指定した内容で作成する。
'
' ------------------------------------------------------------------------
' 引数 : strFilePath ファイルのフルパス
' 　　 　strText 　　ファイルの内容
' 　　 　strErrMsg 　エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFileCreate(ByVal strFilePath As String, ByVal strText As String, Optional ByRef strErrMsg As String = "") As Boolean

　　Dim objStreamWriter As StreamWriter

　　Try

　　　　'------------------------------------------
　　　　' StreamWriter作成
　　　　'------------------------------------------

　　　　objStreamWriter = New StreamWriter(strFilePath, True, System.Text.Encoding.Default)


　　　　'------------------------------------------
　　　　' 内容出力
　　　　'------------------------------------------

　　　　objStreamWriter.WriteLine(strText)


　　　　'------------------------------------------
　　　　' StreamWriter終了
　　　　'------------------------------------------

　　　　objStreamWriter.Close()


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return True


　　Catch ex As Exception

　　　　'--------------------------------------------------
　　　　' エラーメッセージ作成
　　　　'--------------------------------------------------

　　　　strErrMsg = "ファイルを作成できませんでした。" & vbCrLf & _
　　　　　　　　　　"詳細は以下のとおり" & vbCrLf & _
　　　　　　　　　　"----------------------------------------------------------------------" & vbCrLf & _
　　　　　　　　　　ex.Message


　　　　'--------------------------------------------------
　　　　' 戻り値設定
　　　　'--------------------------------------------------

　　　　Return False

　　End Try

End Function



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

ワード文書（*.doc）が開いているかチェックについて

ワード文書（*.doc）が開いているかチェック

ワード文書(*.doc)が開いているかのチェック方法についてです。

ワード文書(*.doc)などを扱う場合、プログラム終了時に他の文書が開いているか確認し、開いている文書が
無ければ、ワード自体を終了させる必要があります。これをしないと、ワード文書を閉じた後も、
ワード(winword.exe)というアプリケーションだけが起動したままになってしまいます。
このあたり、Excelなどでも一緒です。（ExcelとWord位しかやったことが無いのでわかりませんが。。。）

以下のサンプルコードは、同じインスタンス内でのみ開いている文書が無いか確認しています。
ただし、同じインスタンス内でのみ確認すれば問題ないと思います。
・Excelを起動して、同じ画面から他の文書を開いた場合、同じインスタンス内で複数の文書が開いている
　ことになります。
・Excelを起動している状態で、スタートメニューやプログラムから新たにワードを立ち上げ文書を開いた場合、
　別インスタンスで立ち上がります。
　（タスクマネージャで確認すると、winword.exeが複数起動していることが確認できます。）


'==============================================================================
'
'ワード文書が開いているかチェック関連
''
'==============================================================================




'---------------------------------------------------
' 利用方法（以下必要に応じてプロシージャに貼り付けて下さい。）
'---------------------------------------------------

'------------------------------------------------------------
' 事前に参照設定を行なってください。
' 【参照設定方法】
' [プロジェクト]-[参照設定]-[MicroSoft Word 11.0 Object Library]にチェックを入れる。
' (11.0はバージョンにより異なります。ex)11.0 ⇒ Word2003, 9.0 ⇒ Word2000))
'------------------------------------------------------------

''==============================================================================
'
' ワード文書が開いているかチェック
'
'==============================================================================

　　Dim wWD 　　　　As Word.Application
　　Dim wDoc 　　　As Word.Document
　　Dim wWkDoc 　As Word.Document
　　Dim bOpenFlg As Boolean
　　Dim iRet 　　　　As Integer
　　Dim sFileName As String


　　'---ワードオブジェクト作成
　　　　Set wWD = CreateObject("Word.Application")
　　　　 wWD.Visible = True　'←ワードが表示されない場合


　　'---オープン
　　　　Set wDoc = wWD.Documents.Open(App.Path & "\" & "サンプル.doc")


　　'---他のワード文書の開いているかチェック
　　　　bOpenFlg = False
　　　　For Each wDoc In wWD.Documents
　　　　　　sFileName = sFileName & wDoc.Name & vbCrLf
　　　　　　bOpenFlg = True
　　　　Next


　　'---ワード終了（他のワード文書が開いていない場合）
　　　　 If Not bOpenFlg Then
　　　　　　MsgBox "開いているワード文書が無いので、ワードを終了します。"
　　　　　　wWD.Quit
　　　　Else
　　　　　　MsgBox "開いているワード文書があるので、ワードを終了しません。" & vbCrLf & _
　　　　　　　　　　　　"------------------------------" & vbCrLf & _
　　　　　　　　　　　　"ワード文書名：" & sFileName
　　　　End If


　　'---ワードオブジェクト開放
　　　　Set wDoc = Nothing
　　　　Set wDoc = Nothing
　　　　Set wWD = Nothing



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

ワード文書（*.doc）の情報取得について

ワード文書（*.doc）の情報取得

ワード文書(*.doc)の中身を取得するには、単純にテキストを取得する以外にも、オブジェクト（シェイプとか）の
テキストや、表から取得する場合もあります。特に表から取得する場合、
特定の位置の情報（行・列番号を指定して）を取得したい場合もあります。
以下のサンプルコードは、テキストから取得、オブジェクトから取得、表から取得（行・列番号も併せて）の
３種類を載せています。また、VisualBasicでできるので、ExcelなどのVBAでも利用できます。
応用すれば、ワード文書(*.doc)の作成・保存なども可能です。


'==============================================================================
'
'ワード文書の情報取得関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法（以下必要に応じてプロシージャに貼り付けて下さい。）
'---------------------------------------------------

'------------------------------------------------------------
' 事前に参照設定を行なってください。
' 【参照設定方法】
' [プロジェクト]-[参照設定]-[MicroSoft Word 11.0 Object Library]にチェックを入れる。
' (11.0はバージョンにより異なります。ex)11.0 ⇒ Word2003, 9.0 ⇒ Word2000))
'------------------------------------------------------------

''==============================================================================
'
' ワード文書の作成
'
'==============================================================================

　　Const msoTextBox = 1
　　Dim wWD 　　　　As Word.Application
　　Dim wDoc 　　　As Word.Document
　　Dim wTable 　　As Word.Table
　　Dim wCell 　　　As Word.Cell
　　Dim wRange　 　As Word.Range
　　Dim wShape 　　As Word.Shape
　　Dim wPara 　　　As Word.Paragraph
　　Dim iNumCells 　As Integer
　　Dim iTabCount 　As Integer
　　Dim iTabAllCount As Integer
　　Dim sOutput1 　　As String
　　Dim sOutput2 　　As String
　　Dim sOutput3 　　As String
　　Dim bOpenFlg 　As Boolean


　　'---ワードオブジェクト作成
　　　　Set wWD = CreateObject("Word.Application")


　　'---ワード文書作成
　　　　Set wDoc = wWD.Documents.Open("c:\ワード文書サンプル.doc")


　　'---ワード文書の中身を取得
　　　　'ワード情報取得
　　　　For Each wPara In wDoc.Range.Paragraphs
　　　　　　sOutput1 = sOutput1 & wPara.Range.Text & vbCrLf
　　　　Next


　　'---ワード文書の表の中身を取得
　　　　'表数の取得
　　　　iTabAllCount = wDoc.Tables.Count


　　'---ワード情報取得
　　　　sOutput2 = ""
　　　　sOutput2 = sOutput2 & "テーブル番号" & vbTab & _
　　　　　　　　　　　　　　　　　　"行番号" & vbTab & _
　　　　　　　　　　　　　　　　　　"列番号" & vbTab & _
　　　　　　　　　　　　　　　　　　"内容" & vbCrLf & _
　　　　　　　　　　　　　　　　　　"--------------------------------------------------" & vbCrLf

　　　　If iTabAllCount >= 1 Then
　　　　　　For iTabCount = 1 To iTabAllCount
　　　　　　　　'表を取得
　　　　　　　　Set wTable = wDoc.Tables(iTabCount)

　　　　　　　　'セル総数取得
　　　　　　　　iNumCells = wTable.Range.Cells.Count

　　　　　　　　For Each wCell In wTable.Range.Cells
　　　　　　　　　　'セル取得
　　　　　　　　　　Set wRange = wCell.Range

　　　　　　　　　　'セル最後尾にカーソル移動
　　　　　　　　　　wRange.MoveEnd Unit:=wdCharacter, Count:=-1

　　　　　　　　　　'セル情報取得
　　　　　　　　　　sOutput2 = sOutput2 & iTabCount & vbTab & vbTab & _
　　　　　　　　　　wRange.Information(wdStartOfRangeRowNumber) & vbTab & _
　　　　　　　　　　wRange.Information(wdStartOfRangeColumnNumber) & vbTab & _
　　　　　　　　　　wRange.Text & vbCrLf
　　　　　　　　Next

　　　　　　　　sOutput = sOutput & "--------------------------------------------------" & vbCrLf
　　　　　　Next
　　　　End If


　　'---ワード文書のオブジェクトの中身を取得
　　　　sOutput3 = ""
　　　　sOutput3 = sOutput3 & "オブジェクト名" & vbTab & _
　　　　　　　　　　　　　　　　　　"内容" & vbCrLf
　　　　With wDoc
　　　　　　'オブジェクトを一つずつ取得
　　　　　　For Each wShape In .Shapes
　　　　　　　　If wShape.Type = msoTextBox Then
　　　　　　　　　　With wShape.TextFrame.TextRange
　　　　　　　　　　　　For Each wPara In .Paragraphs
　　　　　　　　　　　　　　sOutput3 = sOutput3 & wShape.Name & vbTab & _
　　　　　　　　　　　　　　wPara.Range.Text & vbCrLf
　　　　　　　　　　　　Next
　　　　　　　　　　End With
　　　　　　　　End If
　　　　　　Next
　　　　End With


　　　'---ワード情報出力
　　　　　MsgBox("ワード文書の中身" & vbCRLF & sOutput1)
　　　　　MsgBox("ワード文書の表の中身" & vbCRLF & sOutput2)
　　　　　MsgBox("ワード文書のオブジェクトの中身" & vbCRLF & sOutput3)


　　'---終了
　　　　'他のワード文書の開いているかチェック
　　　　bOpenFlg = False
　　　　For Each wDoc In wWD.Documents
　　　　　　bOpenFlg = True
　　　　Next

　　　　'ワード終了（他のワード文書が開いていない場合）
　　　　'非表示
　　　　wWD.Visible = True
　　　　If Not bOpenFlg Then
　　　　　　wWD.Quit
　　　　End If


　　'---メッセージ
　　　　MsgBox "終了"


　　'---ワードオブジェクト開放
　　　　Set wDoc = Nothing
　　　　Set wWD = Nothing



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

ワード文書（*.doc）の作成について

ワード文書（*.doc）の作成

ワード文書(*.doc)を作成する方法は、ワードオブジェクトの作成 ⇒ 保存、これが基本です。
このあたり、Excelなどでも一緒です。（ExcelとWord位しかやったことが無いのでわかりませんが。。。）
あとは、いかにして思うような文章などを挿入し、成型するかだけだと思います。
以下のサンプルコードは、ページ設定や文章の挿入、表の作成を載せています。
応用すれば、思い描いたとおりのワード文書(*.doc)が作成できます。（多分。。。）


'==============================================================================
'
'ワード文書の作成関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法（以下必要に応じてプロシージャに貼り付けて下さい。）
'---------------------------------------------------

'------------------------------------------------------------
' 事前に参照設定を行なってください。
' 【参照設定方法】
' [プロジェクト]-[参照設定]-[MicroSoft Word 11.0 Object Library]にチェックを入れる。
' (11.0はバージョンにより異なります。ex)11.0 ⇒ Word2003, 9.0 ⇒ Word2000))
'------------------------------------------------------------

''==============================================================================
'
' ワード文書の作成
'
'==============================================================================
　　Dim wWD 　　　　As Word.Application
　　Dim wDoc 　　　As Word.Document
　　Dim wTable 　　As Word.Table
　　Dim wCell 　　　As Word.Cell
　　Dim wRange　 　As Word.Range
　　Dim wShape 　　As Word.Shape
　　Dim wPara 　　　As Word.Paragraph
　　Dim sInpuPath 　As String
　　Dim iCntI 　　　　As Integer
　　Dim iCntJ 　　　As Integer
　　Dim bOpenFlg 　As Boolean

　　 '---保存ファイル名取得
　　　　sInpuPath = "c:\ワード文書サンプル.doc"


　　'---ワードオブジェクト作成
　　　　Set wWD = CreateObject("Word.Application")
　　　　wWD.Visible = False


　　'---ワード文書作成
　　　　'オープン
　　　　Set wDoc = wWD.Documents.Add

　　　　With wDoc
　　　　　　'---ページ設定(書式)
　　　　　　　　With .PageSetup
　　　　　　　　　　.LineNumbering.Active = False
　　　　　　　　　　.Orientation = wdOrientPortrait
　　　　　　　　　　.TopMargin = MillimetersToPoints(35)
　　　　　　　　　　.BottomMargin = MillimetersToPoints(26)
　　　　　　　　　　.LeftMargin = MillimetersToPoints(25)
　　　　　　　　　　.RightMargin = MillimetersToPoints(15)
　　　　　　　　　　.Gutter = MillimetersToPoints(0)
　　　　　　　　　　.HeaderDistance = MillimetersToPoints(15)
　　　　　　　　　　.FooterDistance = MillimetersToPoints(17.5)
　　　　　　　　　　.PageWidth = MillimetersToPoints(210)
　　　　　　　　　　.PageHeight = MillimetersToPoints(297)
　　　　　　　　　　.FirstPageTray = wdPrinterDefaultBin
　　　　　　　　　　.OtherPagesTray = wdPrinterDefaultBin
　　　　　　　　　　.SectionStart = wdSectionNewPage
　　　　　　　　　　.OddAndEvenPagesHeaderFooter = False
　　　　　　　　　　.DifferentFirstPageHeaderFooter = False
　　　　　　　　　　.VerticalAlignment = wdAlignVerticalTop
　　　　　　　　　　.SuppressEndnotes = False
　　　　　　　　　　.MirrorMargins = False
　　　　　　　　　　.TwoPagesOnOne = False
　　　　　　　　　　.GutterPos = wdGutterPosLeft
　　　　　　　　　　.CharsLine = 40
　　　　　　　　　　.LinesPage = 40
　　　　　　　　　　.LayoutMode = wdLayoutModeGrid
　　　　　　　　End With


　　　　　　'---ページ設定（フォント）
　　　　　　　　With wWD.Selection
　　　　　　　　　　.Font.Name = "ＭＳ 明朝"
　　　　　　　　　　.Font.Size = 11
　　　　　　　　End With


　　　　　　'---文書作成
　　　　　　　　With wWD.Selection
　　　　　　　　　　For iCntI = 1 To 10
　　　　　　　　　　　　'文書挿入
　　　　　　　　　　　　.TypeText Text:="テスト文書" & iCntI & vbCrLf

　　　　　　　　　　　　'次行にカーソルを移動
　　　　　　　　　　　　.MoveDown wdLine, Count:=1, Extend:=wdMove
　　　　　　　　　　Next
　　　　　　　　End With


　　　　　　　　'次行にカーソルを移動
　　　　　　　　wWD.Selection.MoveDown wdLine, Count:=1, Extend:=wdMove


　　　　　　'---表作成
　　　　　　　　Set wTable = .Tables.Add(Range:=wWD.Selection.Range, NumRows:=1, NumColumns:=4)

　　　　　　　　'表の設定
　　　　　　　　With wTable
　　　　　　　　　　'表位置
　　　　　　　　　　.Rows.LeftIndent = MillimetersToPoints(14.5)
　　　　　　　　　　'列幅
　　　　　　　　　　.Columns(1).SetWidth ColumnWidth:=MillimetersToPoints(35), RulerStyle:=wdAdjustNone
　　　　　　　　　　.Columns(2).SetWidth ColumnWidth:=MillimetersToPoints(35), RulerStyle:=wdAdjustNone
　　　　　　　　　　.Columns(3).SetWidth ColumnWidth:=MillimetersToPoints(35), RulerStyle:=wdAdjustNone
　　　　　　　　　　.Columns(4).SetWidth ColumnWidth:=MillimetersToPoints(35), RulerStyle:=wdAdjustNone
　　　　　　　　End With

　　　　　　　　'表への値挿入
　　　　　　　　With wWD.Selection
　　　　　　　　　　For iCntI = 1 To 10
　　　　　　　　　　　　'行挿入
　　　　　　　　　　　　If iCntI > 1 Then
　　　　　　　　　　　　　　.InsertRowsBelow 1
　　　　　　　　　　　　End If

　　　　　　　　　　　For iCntJ = 1 To 4
　　　　　　　　　　　　　　'文書挿入
　　　　　　　　　　　　　　.TypeText Text:="表文書(" & iCntI & ", " & iCntJ & ")"

　　　　　　　　　　　　　　'右隣にカーソルを移動
　　　　　　　　　　　　　　If iCntJ <> 4 Then
　　　　　　　　　　　　　　　　.MoveRight wdCell, Count:=1, Extend:=wdMove
　　　　　　　　　　　　　　End If
　　　　　　　　　　　　Next

　　　　　　　　　　　　'左端にカーソルを移動
　　　　　　　　　　　　.MoveLeft wdCell, Count:=3, Extend:=wdMove
　　　　　　　　　　Next
　　　　　　　　End With

　　　　　　　　'保存
　　　　　　　　.SaveAs sInpuPath

　　　　　　　　'クローズ
　　　　　　　　.Close
　　　　End With


　　'---終了
　　　　'他のワード文書の開いているかチェック
　　　　bOpenFlg = False
　　　　For Each wDoc In wWD.Documents
　　　　　　bOpenFlg = True
　　　　Next

　　　　'ワード終了（他のワード文書が開いていない場合）
　　　　'非表示
　　　　wWD.Visible = True
　　　　If Not bOpenFlg Then
　　　　　　wWD.Quit
　　　　End If


　　'---メッセージ
　　　　MsgBox "終了"


　　'---ワードオブジェクト開放
　　　　Set wDoc = Nothing
　　　　Set wWD = Nothing



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

四捨五入・切上げ・切捨てについて

四捨五入・切上げ・切捨て

四捨五入については，よくさまざまな議論がされていますが，単純に
「4より小さければ切り捨て」，「5より大きければ切り上げ」したい場合，
標準のRound関数では実現できません。（銀行型四捨五入と言われている「最近接偶数丸め」だからかな？）
なので，自分で関数を作成する必要があります。
以下はその例です。ついでに切上げ・切り捨ても付けてみました。


'==============================================================================
'
' 四捨五入・切上げ・切捨て関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法（以下必要に応じてプロシージャに貼り付けて下さい。）
'---------------------------------------------------

''==============================================================================
'
' 四捨五入（切上げ, 切捨て）
'
'
' ------------------------------------------------------------------------
' 説明 : 四捨五入（切上げ, 切捨て）をする
'
' ------------------------------------------------------------------------
' 引数 : sValue 四捨五入（切上げ, 切捨て）をする値
' 　　 : iMode 0:四捨五入, 1:切上げ, 2:切捨て
' 　　 : iKeta 四捨五入（切上げ, 切捨て）をする位(第ｎ位)
' 戻値 : Double 計算結果
'
'==============================================================================

Public Function fnc_Round_Value(sValue As Variant, iMode As Integer, iKeta As Integer) As Double
Dim dWkValue As Double

　　'---戻り値初期化
　　　　fnc_Round_Value = 0


　　'---値チェック
　　　　If Not IsNumeric(sValue) Then
　　　　　　Exit Function
　　　　End If


　　'---計算
　　　　Select Case iMode
　　　　　　Case 0
　　　　　　　　'四捨五入
　　　　　　　　dWkValue = Int((sValue * (10 ^ (iKeta - 1)) + 0.5)) / (10 ^ (iKeta - 1))

　　　　　　Case 1
　　　　　　　　'切上げ
　　　　　　　　dWkValue = Int((sValue * (10 ^ (iKeta - 1)) + 0.9)) / (10 ^ (iKeta - 1))

　　　　　　Case 2
　　　　　　　　'切捨て
　　　　　　　　dWkValue = Int((sValue * (10 ^ (iKeta - 1)))) / (10 ^ (iKeta - 1))

　　　　End Select


　　'---戻り値設定
　　　　fnc_Round_Value = dWkValue

End Function



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

マウスの座標について

マウスの座標

マウスの座標を取得する方法についてです。
マウスがフォームの外側，或いは透明フォーム等，MouseMoveイベントを利用出来ない場合に便利です。


'=======================================================================
'
' カーソル関連
'
'=======================================================================

'--------------------
' API宣言
'--------------------
　　'---カーソルの現在のスクリーン座標の取得
　　　　Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
　　'---キーボードのキーが押されているかどうか調べる
　　　　Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer

　　'---定数宣言
　　　　Public Type POINTAPI
　　　　　　x As Long
　　　　　　y As Long
　　　　End Type




'---------------------------------------------------
' 利用方法（以下必要に応じてプロシージャに貼り付けて下さい。）
'---------------------------------------------------

　　'---<< カーソル位置取得 >>
　　　　Dim pPoint 　　　　　As POINTAPI

　　　　'---カーソル位置取得
　　　　　　Call GetCursorPos(pPoint)


　　　　'---カーソル位置表示
　　　　　　MsgBox "X座標：" & pPoint.x
　　　　　　MsgBox "Y座標：" & pPoint.y


　　　　'---マウス状態
　　　　　　If GetAsyncKeyState(vbKeyRButton) < 0 Then
　　　　　　　　MsgBox "マウスの右ボタンがクリックされてます。"
　　　　　　End If
　　　　　　If GetAsyncKeyState(vbKeyLButton) < 0 Then
　　　　　　　　MsgBox "マウスの左ボタンがクリックされてます。"
　　　　　　End If



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

スクリーンセーバーの実行について

スクリーンセーバーの実行

スクリーンセーバーを実行する方法についてです。


'=======================================================================
'
' スクリーンセーバー関連
'
'=======================================================================

'--------------------
' API宣言
'--------------------
　　'---指定のウィンドウのメッセージキューにメッセージを送る
　　　　Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, _
　　　　　　　　　　　　　　　　　　　　ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long


　　'---定数宣言
　　　　Public Const WM_SYSCOMMAND = &H112 　'ポストするメッセージID（システムコマンドを指定）
　　　　Public Const SC_SCREENSAVE = &HF140& 'スクリーンセーバー実行




'---------------------------------------------------
' 利用方法（以下必要に応じてプロシージャに貼り付けて下さい。）
'---------------------------------------------------

　　'---<<スクリーンセーバー実行 >>
　　　　 Dim lRet As Long

　　　　'---スクリーンセーバーを実行するメッセージをポスト
　　　　　　lRet = PostMessage(Me.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, ByVal CLng(0))



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

スクリーンセーバーについて

スクリーンセーバー

スクリーンセーバーの作成方法についてです。
スクリーンセーバーの作成方法は，単純です。
まず，作成した実行ファイル（*.exe）の拡張子を"scr"に変更します。
以上で終わりです。
利用方法は，このスクリーンセーバーのファイル（*.scr）をWindowsHome（※）の直下に配置します。
次に，画面のプロパティからスクリーンセーバータブで，先ほど配置したスクリーンセーバを選択します。
これで，作成したスクリーンセーバーが動きます。あら簡単！
作成する際のPointとして，マウス移動時に終了するなど，終了のトリガーを入れる事を忘れないように
して下さい。以下は，簡単な作成例です。
※．Windows2000の場合，C:\WinNT，WindowsXPの場合，C:\Windows


'==============================================================================
'
' スクリーンセーバー関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法
'　FormにLabelとTimerコントロールを貼り付け，
'　以下のソースをコピペして下さい。
'---------------------------------------------------

　　'---<< スクリーンセーバー >>
　　　　Dim mbFastFlg As Boolean
　　　　Dim msBeforeX As Single
　　　　Dim msBeforeY As Single



　　　　　　Private Sub Form_Load()

　　　　　　　　'---初回フラグ:ON
　　　　　　　　　　mbFastFlg = True

　　　　　　　　'---Window最大化
　　　　　　　　　　Form1.WindowState = 2

　　　　　　　　'---タイマー開始
　　　　　　　　　　Timer1.Interval = 1

　　　　　　End Sub

　　　　　　Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

　　　　　　　　'---マウス移動判定
　　　　　　　　　　If Not mbFastFlg Then
　　　　　　　　　　　　If X <> msBeforeX Or Y <> msBeforeY Then
　　　　　　　　　　　　　　Unload Me
　　　　　　　　　　　　End If
　　　　　　　　　　End If

　　　　　　　　'---初回フラグ:OFF
　　　　　　　　　　mbFastFlg = False

　　　　　　　　'---マウス位置退避
　　　　　　　　　　msBeforeX = X
　　　　　　　　　　msBeforeY = Y

　　　　　　End Sub

　　　　　　Private Sub Timer1_Timer()

　　　　　　　　'---タイマー
　　　　　　　　　　If Label1.Caption <> Time Then
　　　　　　　　　　　　Label1.Caption = Time
　　　　　　　　　　End If

　　　　　　End Sub



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

画像の縮小（サムネイル）について

画像の縮小（サムネイル）

画像のサムネイル作成方法についてです。
サムネイルの作成方法は，多数ありますが表示速度やメモリ使用量，解像度など考えなければいけない
要素があります。ここで紹介している方法では，元画像をいったんロードしている為，表示速度は
速くありませんが元画像をサムネイル作成後に破棄している分，サムネイルを同時に複数作成しても
メモリ使用量を抑えられます。
（サンプルでは，サムネイルは1つしか作成していません。）


'==============================================================================
'
' サムネイル関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法（以下必要に応じてプロシージャに貼り付けて下さい。）
'---------------------------------------------------

　　'---<< サムネイル作成 >>
　　　　Dim sFile As String
　　　　Dim dHeight As Double
　　　　Dim dWidth As Double
　　　　Dim dNewHeight As Single
　　　　Dim dNewWidth As Single

　　　　Const iPicHeight = 3000
　　　　Const iPicWidth = 3000

　　　　On Error GoTo Err

　　　　'---ファイル取得
　　　　　　sFile = "c:\aaa\bbb\ccc\ddd.bmp"


　　　　'---画像クリア
　　　　　　Picture1.Cls


　　　　'---幅と高さを調べるために、一旦 Picture オブジェクトに格納
　　　　　　Picture2.Picture = LoadPicture(sFile)


　　　　'---元画像の幅・高さ取得
　　　　　　dHeight = Picture2.Picture.Height
　　　　　　dWidth = Picture2.Picture.Width


　　　　'---元画像の幅・高さがサムネイルの範囲を超える場合のみ縮小するサイズを取得
　　　　　　If dHeight > 0 Or dWidth > 0 Then

　　　　　　　　'元画像の幅・高さどちらかでもサムネイルの範囲を超えるかチェック
　　　　　　　　If dHeight > iPicHeight Or dWidth > iPicWidth Then

　　　　　　　　　　'元画像の幅・高さどちらかがサムネイルの範囲を超える場合
　　　　　　　　　　If dHeight > dWidth Then

　　　　　　　　　　　　'高さが幅より範囲を大きく超えている場合，高さの縮小率に併せて幅を縮小
　　　　　　　　　　　　dNewHeight = iPicHeight
　　　　　　　　　　　　dNewWidth = dWidth / dHeight * iPicHeight
　　　　　　　　　　Else

　　　　　　　　　　　　'幅が高さより範囲を大きく超えている場合，幅の縮小率に併せて高さを縮小
　　　　　　　　　　　　dNewWidth = iPicWidth
　　　　　　　　　　　　dNewHeight = dHeight / dWidth * iPicWidth
　　　　　　　　　　End If

　　　　　　　　Else

　　　　　　　　　　'元画像の幅・高さどちらかがサムネイルの範囲を超えない場合
　　　　　　　　　　dNewHeight = dHeight
　　　　　　　　　　dNewWidth = dWidth
　　　　　　　　End If
　　　　　　End If


　　　　'---サムネイルの大きさ変更
　　　　　　Picture1.Height = dNewHeight
　　　　　　Picture1.Width = dNewWidth
　　　　　　DoEvents


　　　　'---サムネイル作成
　　　　　　Picture1.PaintPicture Picture2.Picture, 0, 0, dNewWidth / 0.567, dNewHeight / 0.567, _
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　0, 0, Picture2.Picture.Width, Picture2.Picture.Height


　　　　'---元画像破棄
　　　　　　Set Picture2 = Nothing


　　　　'---終了
　　　　　　Exit Sub

　　Err:
　　　　'---エラー処理
　　　　　　sErrMsg = "エラーが発生しました。" & vbCrLf & _
　　　　　　　　　　　　　Err.Number & " " & Err.Description
　　　　　　MsgBox sErrMsg, vbCritical, "サムネイルサンプル"
　　　　　　Exit Sub



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

メールの送信（CDO）について

メールの送信（CDO）

CDO(Microsoft Collaboration Data Objects)を利用したメールの送信方法についてです。
CDOの参照設定を行ったほうが，より使い易くなりますが，あえて環境に依存しない方法で
作成しました。この方法だとVB以外にも，Excel（VBA）やWSH（VBScript）でも使用できます。

'==============================================================================
'
' メール送信関連
'
'==============================================================================
　　'---定数宣言
'---CDO関連の定数
Private Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Private Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Private Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Private Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Private Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Private Const cdoSendUsingPort = 2
Private Const cdoAnonymous = 0
Private Const cdoShift_JIS = "shift-jis"
Private Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Private Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"




'---------------------------------------------------
' 利用方法（以下必要に応じてプロシージャに貼り付けて下さい。）
'---------------------------------------------------

　　'---<< フォーム透明化 >>
　　　　Dim oMsg As Object
　　　　Dim sSMTPServer As String
　　　　Dim bSMTP_Flg As Boolean
　　　　Dim sUserName As String
　　　　Dim sPassWord As String
　　　　Dim sFrom As String
　　　　Dim sTO As String
　　　　Dim sCC As String
　　　　Dim sBCC As String
　　　　Dim sSubject As String
　　　　Dim sTextBody As String
　　　　Dim vFile As Variant
　　　　Dim sFile As String
　　　　Dim iLoopCnt As Integer
　　　　Dim sErrMsg As String

　　　　On Error GoTo Err

　　　　'---確認
　　　　　　If MsgBox("メールを送信します。よろしいですか？", vbQuestion + vbYesNo, _
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　"メール送信(CDO)サンプル") = vbNo Then
　　　　　　　　Exit Sub
　　　　　　End If


　　　　'---メール送信情報取得
　　　　　　sSMTPServer = "[e-mail](or 999.999.999.999)" 'SMTPサーバ
　　　　　　bSMTP_Flg = False　　　　　 'SMTPサーバ：認証有無
　　　　　　sUserName = "UserName" 'SMTPサーバ：認証用ユーザ名
　　　　　　sPassWord = "PassWord" 　'SMTPサーバ：認証用パスワード


　　　　'---メール送信内容取得
　　　　　　sFrom = "[e-mail]" 　　'差出人
　　　　　　sTO = "[e-mail]" 　　　　　'宛先
　　　　　　sCC = "[e-mail]" 　　　　　'CC
　　　　　　sBCC = "[e-mail]" 　　　'BCC
　　　　　　sSubject = "件名を入力して下さい。" 　'件名
　　　　　　sTextBody = "本文を入力して下さい。" '本文


　　　　'---CDOオブジェクト作成
　　　　　　Set oMsg = CreateObject("CDO.Message")


　　　　'---CDOオブジェクト設定＆送信
　　　　　　With oMsg
　　　　　　　　'メール送信情報設定
　　　　　　　　If sSMTPServer <> "" Then
　　　　　　　　　　With .Configuration.Fields
　　　　　　　　　　　　'SMTPサーバ
　　　　　　　　　　　　.Item(cdoSendUsingMethod) = cdoSendUsingPort
　　　　　　　　　　　　.Item(cdoSMTPServer) = sSMTPServer 'SMTPサーバ
　　　　　　　　　　　　.Item(cdoSMTPServerPort) = 25

　　　　　　　　　　　　''SMTPサーバ：認証有無判定
　　　　　　　　　　　　If bSMTP_Flg = True Then
　　　　　　　　　　　　　　.Item(cdoSMTPAuthenticate) = cdoAnonymous
　　　　　　　　　　　　　　.Item(cdoSendUserName) = sUserName 'SMTPサーバ：認証用ユーザ名
　　　　　　　　　　　　　　.Item(cdoSendPassword) = sPassWord　 'SMTPサーバ：認証用パスワード
　　　　　　　　　　　　End If

　　　　　　　　　　　　'設定更新
　　　　　　　　　　　　.Update
　　　　　　　　　　End With
　　　　　　　　End If

　　　　　　　　'メール送信内容設定
　　　　　　　　.From = sFrom 　　　　　　'差出人
　　　　　　　　.To = sTO 　　　　　　　　　'宛先
　　　　　　　　.cc = sCC 　　　　　　　　　'CC
　　　　　　　　.bcc = sBCC 　　　　　　　'BCC
　　　　　　　　.Subject = sSubject 　　　'件名
　　　　　　　　.TextBody = sTextBody '本文

　　　　　　　　'添付ファイル
　　　　　　　　.AddAttachment "C:\aaa\bbb\ccc\001.txt"
　　　　　　　　.AddAttachment "C:\aaa\bbb\ccc\002.txt"
　　　　　　　　.AddAttachment "C:\aaa\bbb\ccc\003.txt"

　　　　　　　　'メール送信
　　　　　　　　.Send

　　　　　　End With


　　　　'---CDOオブジェクト解放
　　　　　　Set oMsg = Nothing

　　　　　　MsgBox "メールを送信しました。", vbInformation, "メール送信(CDO)サンプル"

　　　　　　Exit Sub

　　Err:
　　　　'---エラー処理
　　　　　　sErrMsg = "エラーが発生しました。" & vbCrLf & _
　　　　　　Err.Number & " " & Err.Description
　　　　　　MsgBox sErrMsg, vbCritical, "メール送信(CDO)サンプル"
　　　　　　Exit Sub



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

Windowの整列について

Windowの整列

MDIフォームのWindowの整列方法についてです。
簡単で載せるほどたいしたことはありませんが，便利なので載せました。


'=======================================================================
'
' Window関連
'
'=======================================================================

'---------------------------------------------------
' 利用方法（以下必要に応じてプロシージャに貼り付けて下さい。）
'---------------------------------------------------

　　 '---<< Window整列 >>
　　　　　'Index値
　　　　　'0:整列-重ねて表示
　　　　　'1:上下に並べて表示
　　　　　'2:左右に並べて表示
　　　　　MDIForm1.Arrange (Index)



【宣伝・・・(*´ω｀)】



　システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。