2013-06-20

ExcelVBAおぼえがきFunction 2

今回は主にDB関係かなー。
色々VBAで社内ツールを作ってはいるけどあんまり公開するほど汎用性の高い関数はできないね。

クエリ発行

accessファイルにクエリ発行する。取得したデータは指定したセルを起点としてベタっと貼り付け。
コレを標準モジュールに入れておけば安泰。

Option Explicit

'変数
'office2007用
Private Const strProvider = "Provider=Microsoft.ACE.OLEDB.12.0;"
'DBファイルパス
Private strDbPath As String

'関数
'DBファイルパス設定
Public Sub SetDbPath(ByVal buf As String)
    strDbPath = "Data Source=" & buf & ";"
End Sub

'クエリ発行
'登録, 更新
Public Sub QueryExecute(ByVal strSQL As String)
    Dim connect As New ADODB.Connection
    
    'エラー制御ON(DEBUG用)
    On Error GoTo SQLERROR
    
    'DB接続
    connect.Open strProvider & strDbPath
    
    'クエリ発行
    Call connect.Execute(strSQL)
    
    'エラー制御OFF(DEBUG用)
    On Error GoTo 0
    
    'terminate
    connect.Close
    Set connect = Nothing
    
    Exit Sub
    
SQLERROR:
    Call ErrorInfo(connect, strSQL)
End Sub

'検索
Public Sub QuerySelect(ByVal strSQL As String, ByVal rngTarget As Range)
    Dim connect As New ADODB.Connection
    Dim recordset As New ADODB.recordset
    
    'エラー制御ON(DEBUG用)
    On Error GoTo SQLERROR
    
    'DB接続
    connect.Open strProvider & strDbPath
    
    'クエリ発行
    recordset.Open strSQL, connect, adLockReadOnly
    
    'データ格納
    rngTarget.CopyFromRecordset recordset
    
    'エラー制御OFF(DEBUG用)
    On Error GoTo 0
    
    'terminate
    recordset.Close
    Set recordset = Nothing
    connect.Close
    Set connect = Nothing
    
    Exit Sub
    
SQLERROR:
    Call ErrorInfo(connect, strSQL)
End Sub


'エラー詳細の表示
Private Sub ErrorInfo(ByVal connect As ADODB.Connection, ByVal strSQL As String)
    
    Debug.Print "=== ERROR ==="
    
    'イミディエイトウィンドウへエラー詳細を出力
    With connect.Errors.Item(0)
        Debug.Print " Description=" & .Description
        Debug.Print " HelpContext=" & .HelpContext
        Debug.Print " HelpFile=" & .HelpFile
        Debug.Print " NativeError=" & .NativeError
        Debug.Print " Number=" & .Number
        Debug.Print " Source=" & .Source
        Debug.Print " SQLState=" & .SqlState
    End With
    
    Debug.Print " SQL=" & strSQL
    
    Debug.Print "=== ERROR ==="
End Sub

SQL文作成

WHERE句を複数つけたり付けなかったりする。
入力した検索条件が複数ならif文内をまるごとコピーするのが手っ取り早いかしら。loopで回してもいいと思うー。
取得したデータの貼り付け先などは適宜変更してください。

Private Sub SelectData(ByVal TblName As String)
    Dim strSQL As String
    Dim ret As Integer
    
    strSQL = "SELECT * FROM " & TblName & " "
    
    '検索条件
    If 入力した検索条件 <> "" Then
        ret = InStr(1, strSQL, "WHERE", vbBinaryCompare)
        
        '絞り込み
        strSQL = strSQL & IIf(ret <> 0, IIf(IsNull(ret) = False, "AND ", "WHERE "), "WHERE ")
        strSQL = strSQL & "○○ = '" & 入力した検索条件 & "' "
    End If
    
    strSQL = strSQL & ";"
    
    'Debug.Print strSQL
    
    'クエリ発行
    Call QuerySelect(strSQL, Range("A1"))
End Sub

2013-02-10

WSHでzip解凍＆圧縮

プログラム

なんか下書きしたまんまの記事があったのであっぷ。
WSHでzipフォルダ内のzipファイルを解凍し、必要なデータだけ抜き出して再圧縮してますね。
社内用ツールとして作った産物なので一部ボカして載せてるので多分ちゃんと動かないと思います。その辺は自己解決よろでっす。

動作確認：WindowsXP SP3

Option Explicit

'---------------------------------------------
'メイン処理
'---------------------------------------------
Call main()
WScript.Quit 0


'---------------------------------------------
'---------------------------------------------
Dim rootPath
Dim zipPath
Dim dataPath
Dim updatePath
Dim workPath

'---------------------------------------------
'メイン関数
'---------------------------------------------
Sub main()
	
	rootPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"")
	zipPath = rootPath & "zip\"
	dataPath = rootPath & "data\"
	updatePath = rootPath & "update\"
	
	With CreateObject("Scripting.FileSystemObject")
		'中間フォルダ作成
		workPath = .BuildPath(rootPath, .GetTempName)
		.CreateFolder(workPath)
		
		'メイン処理
		'zipファイルを軸に***ファイルを補完していく
		Call funcMain(.GetFolder(zipPath))
		
		'中間フォルダ削除
		.DeleteFolder(workPath)
	End With
	
	Msgbox "実行終了"
End Sub


'---------------------------------------------
'メイン処理関数
'---------------------------------------------
'---------------------------------------------
'	IN：	zipファイル格納フォルダ
'---------------------------------------------
Sub funcMain(objTargetFolder)
	Dim objFolder
	Dim objFile
	Dim objDataFolder
	Dim objDataFile
	
	'再帰処理
	For Each objFolder In objTargetFolder.SubFolders
		Call funcMain(objFolder)
	Next
	'@@@DEBUG
	'msgbox objTargetFolder
	
	With CreateObject("Scripting.FileSystemObject")
		For Each objFile In objTargetFolder.Files :Do
			'zipファイルでない場合は繰り返し
			If LCase(.GetExtensionName(objFile.Name)) <> "zip" Then Exit Do
			
			'作業フォルダに解凍
			With CreateObject("Shell.Application")
				.NameSpace(workPath).CopyHere .NameSpace(objFile.path).Items
			End With
			
			'データをコピーする
			For Each objDataFile In .GetFolder(dataPath).Files :Do
				'***ファイルでない場合は繰り返し
				If LCase(.GetExtensionName(objDataFile.Name)) <> "***" Then Exit Do
				
				'作業フォルダにコピー
				'@@@DEBUG
				'msgbox objDataFile.path
				'msgbox workPath
				.CopyFile objDataFile.path, workPath & "\"
			Loop until 1 :Next
			
			'ファイル圧縮
			Call compressFile(Replace(WScript.ScriptFullName, WScript.ScriptName, objFile.Name))
			
			'ファイル移動
			.MoveFile Replace(WScript.ScriptFullName, WScript.ScriptName, objFile.Name) updatePath
			
			'作業フォルダ内のファイルを削除する
			.DeleteFile workPath & "\*"
		Loop until 1 :Next
	End With
End Sub


'---------------------------------------------
'ファイル圧縮処理関数
'---------------------------------------------
'---------------------------------------------
'	IN：	zipファイル名
'---------------------------------------------
Sub compressFile(zipFileName)
	Dim i
	Dim objFile
	Dim strbuf
	Dim aryHex
	
	'zipファイルを作るためのおまじない
	aryHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
	For i = 0 To UBound(aryHex)
		strbuf = strbuf & Chr(aryHex(i))
	Next
	
	'zipファイル作成
	With CreateObject("Scripting.FileSystemObject").CreateTextFile(zipFileName, True)
		.Write strbuf
		.Close
	End With
	
	With CreateObject("Scripting.FileSystemObject")
		'フォルダ内のファイルを全て格納
		For Each objFile In .GetFolder(workPath).Files
			CreateObject("Shell.Application").NameSpace(zipFileName).CopyHere(objFile.path)
			
			WScript.sleep 3000
		Next
	End With
End Sub

2013-01-28

Nexus7のXperia化計画

android

Nexus7使いやすくて好きなんですが、Xperiaになれてる私としてはちょっとなー悪い人じゃないんだろうけどなんてゆーかーフィーリング？が合ってないってゆーかーとなったのでさくっとXperiaっぽく。

Xperiaランチャーのインストール

GooglePlayにもそのうち出すわーとかいってるぽいですが、単純にapkダウンロードしてインストールするだけです。

触った感じとしてはかなり、いいです。というかAndroid2.x世代のXperiaホームよりかなり使い勝手がいい。
ホーム画面数変更できるし、無限ループもできる。アイコンの設置数も変更可能。
ドロワーも同様。非表示アプリも選択できるのでウィジェットからしかアクセスしないconkyアプリや壁紙アプリとかのアイコンをすっきり隠せる。
ちゃんと横表示もに対応してるし申し分ないっす。動作も快適だしねー。NOVAとかはまぁカスタマイズしたい人が使えば…いいんじゃないですか、ね？( ´ ー ` )
ポテトチップスはコンソメやうす塩派は断然オススメです。

POBox5.1のインストール

ATOKやらgoogle日本語入力とかありますが、ぶっちゃけPOBox信者なのでー。shimeji？ああ、しばらく使ってたけどフリック反応ちょーヤバい。トロすぎるわくそめ。googleはマッシュルーム非対応だしATOK金取るじゃないですかーやだー。

参考にしたのはこちら。
基本ココ見ておけば大丈夫だと思いますが、いくつか補足を。

ADBコマンド使用可能状態にしても、NEXUS7用のドライバをPCに入れないと認識しないのでbatファイル叩いても失敗する。なのでNexus 7のドライバインストール方法を参照してドライバをインストールすること。
Android4.2以降は開発者オプションがデフォルトで表示されていないので注意。Nexus 7 Android 4.2で消えた開発者向けオプションを表示させる方法を参照すること。

これでPOBoxが使えるようになります。

とりあえずこれでかなり使い勝手がよくなったのでますますN7生活が捗るようになりましたマジオススメ(´ω`)

2012-10-17

立川ルミネで聖☆おにいさんのスタンプラリーやってきました

雑記

会社の仕事が暇すぎて有給とってごめんなさい。
残業はしたくないけど程ほどに忙しいのが一番ですよね、時間がたつのも早いし。
あんまりむやみに有給は使いたくないのだけれど、今会社でボーっとしてたら確実にNexus7で挙動不審になりそうだったので。えへ。

なのでついでといってはあれですが、立川ルミネで2012/10/15-10/31に開催してる聖☆おにいさんのスタンプラリーでクリアファイルゲットに行ってきました。

ポイント1

まずは7F Zoffへ。近くに一緒に写真が取れる大きなPOPがあります。その隣にスタンプ台と用紙がおいてあります。

ポイント2

順番に回ってもいいけど面倒なので上から攻めるよ！
そのまま近くのエスカレータで8Fへ。
近くに4つ目のスタンプ台があります。

ポイント3

そのままエスカレータで6Fへ。ヴィレッジ・バンガードの向かいに3つ目のスタンプ台があります。

ポイント4

最後にエスカレータで4Fへ行き、駐車場通路に行くと2つ目のスタンプ台が。

クリアファイルゲット

スタンプが集まった用紙を7Fのルミネカードサロンに持っていくとクリアファイルがもらえます。

2012-07-21

docomoパケホーダイ vs UQWimax

雑記

Wimaxとスマホのパケホーダイどっちがいいのか、ちょっと整理してみようの巻。
　

経緯

お金がない。（バッサリ
現在所持しているWiFi対応の端末は以下の通りなのです。

iPod touch
iPad
スマホ（Xperia arc / acro）
ネットブック（DELL mini9）
ノートPC（vaio）
PSP（2000 / 3000）

他にもDSとかwiiとかあるんですがここ1年使ってないので除外。というか持ち歩かないしね！
　
もちろんフルで使うことなんてまずないんですが、外で十分に機能を発揮できるのは上のうちスマホだけという状態。
なんかもったいないなぁ。でもただでさえ家庭は普通に光契約しつつパケホーダイ払いつつ更に持ち出し用のWiFi端末はちょっと…と思ってました。
よくカフェで無線LANスポットあるけど、ノマド（）なんてしないし必要なのは道端というか移動中なのでいちいちカフェ入ってなにしてとかめんどくさすぎる。
というわけでとりあえず基本スマホでなんとかするようにして帰省時とかはホテルのLANを無線ルーターにつける方法で対応してました。
　
んが、こんな記事を最近発見。
docomoのスマートフォンを徹底的に安く利用する: 小粋空間
 docomoのスマートフォンを徹底的に安く利用する（その後）: 小粋空間
ちょ、持ってる機種からやろうと思ってた事まで丸かぶりや！要チェックや！ということで熟読。
とりあえず私の実状と照らしつつ情報の整理を行いたいと思います。

docomo

電話番号はさすがに使用頻度が低いとはいえあったほうがいいしSPモードメールも個人的にはいらないけれど嫁さんとはやっぱり使うので使いたい。
ということでとりあえず焦点は金銭面のみ。期間は去年7月に購入したため、今後最低1年はacroを使い続けるとして1年間。
　
まずは基本料。
現在FOMAタイプSS バリュー（980円）。これをメール使いホーダイタイプシンプルバリュー（780円）に変更することで200円の削減。
と行きたいところだけど、過去の請求額を見るに無料通話分（1,000円）で相殺する程度には通話をしているので（嫁さんと親）保留。
　
次にパケット料。
現在パケ・ホーダイ　フラット（5,200円）。これをメール使いホーダイタイプシンプルバリューのためパケ・ホーダイシンプル（0円〜5,985円）
スマホの設定で3G接続をカットするためよほどのことがない限り0円運用可能だと仮定します。
　
しかし、パケ・ホーダイ　フラットを解除することにより月々サポート割が消滅することにより、1,340*12=16,080の費用が発生。
ここの負担分を減った月額が吸収できるかがポイントでせう。

WiMAX

軽く調べただけでも公式・価格com・各ISPと色々窓口があり、それぞれキャッシュバックやらなにやら言っててよくわからない。。
とりあえず公式で確認。ルーターはMobile Cube。最新のAtermでもいいんだけど、基本持ち歩くため駆動時間が同じで重量低いほうに。
商品価格として7,800円。更にプランはUQ Flat年間パスポートで3,880円。おわり。
もちろん価格comとか別ISPにすればキャッシュバックやらがあるのでお安くなります。2年縛りになるけど。
ノートPCに内蔵されてるので200円追加して登録してもいいんだけど、ルーターの同時接続数内なので放置。そもそもノートPCでWiMAX使う気がしない。

予想されるメリット・デメリット

固定費の削減（メリット）

上記により、約1,400円月に払う金額が減る計算に。
1年で16,800円かー。それでスマホ以外もネット使えるのなら悪くない数字ですね。負担分もなんとかカバーしてる感じ。

電源関係（デメリット）

大震災当時ガラケー持ちだったんですが運悪く充電せずに出社しており、同僚からケーブル借りて充電した事もあって今は会社に充電ケーブル完備。
おまけにエネループのUSB出力付ハンディ電源も会社に置いてるので、いざとなったら会社の非常用乾電池と組み合わせての充電も可能。
　
家・会社での毎日の充電は習慣化すれば問題ないと思うし実際スマホはそうしているのでおそらく大丈夫だと思う。
なので、基本的にルーターは常時電源ONで家や会社では即充電（過充電防止装置があるのでリスクは0）する運用で。

接続関係（メリット/デメリット）

WiFi接続で使えるのは実証済みだけど家以外では3G。でした。
今月から別件で会社が無線LAN端末を敷設し、外部からの訪問者用に用意しているSSIDを個人で使用してもイイヨーと許可を（どさくさにまぎれて）得たので会社ではWiFi環境ある＝docomo3Gツカワネ。
問題は移動中のみとなり、WiMAXに求めるハードルはぐっと低くなりました。
移動中特に電車内は朝は通信状態があまりよくないので、これで多少改善されるとちょお嬉しいんですがそこはTryで試すとして。
とくにそれで問題なければそもそもスマホでいる必要がなくなるため、白ロムガラケーで電話格安運用しつつ7インチあたりのタブレットでネット見たり動画見たり音楽聴いたりできるようになります。
また、ルーターを常備することで嫁さん所持のiPadも生きてくるわけで。ノートPCは内蔵型なので単品持ち歩きでオッケー。
このへんがメリット。
　
デメリットとしては、ルーター起動から接続までに若干時間がかかること。しかしソコは常時電源ONにすることで回避可能。
あとは接続有効範囲ですが、基本行動範囲と私の実家は東京にあるので問題なし。
嫁さんの実家もサイトで確認する限りは範囲内。移動時の高速とかでは使えないかーといったところ。ただそれは今までも同じだし移動中はどうせ私が運転するので通信関係ないしそんなに見たければ嫁さんのarcで見ればいいだけでしょう。二人ともWiMAXにする必要はないと思うし。するとしてもしばらく私が変えて様子を見てからですかね。