徒然なるままに・・・

ふ・ふぉぉぉぉw|;ﾟﾛﾟ|w　　おつかれ。inukoroでつ。


あつい。じめじめ。いやぁぁぁぁぁぁ(´＿｀｡)

もうも暑いのはともかく、じめじめはやめてほしい。
西岸海洋性気候　辺りがいいでつねぇ~~-v(*￣･￣)｡｡o

今日はお仕事やる気がゼロでした。携帯ピコピコー。
部屋から脱出。お客に出くわさないようにメタルギアだ。

ってなわけで、今日ラストを記述しまつ。。。


xlsに出力するところから。

'********************xls書き込み************************

dim excelapp
dim excelbook
dim x

x=1

set excelapp=createobject("excel.application")
set excelbook=excelapp.workbooks.open(filepath)'filepathにxlsのあるパスを記述だ。

excelapp.visible=false

excelapp.activeworkbook.worksheets("tmpシート").select'とりあえず、tmpシートに出す。




set resulttext=createobject("scripting.filesystemobject")
set opresult=resulttext.opentextfile (targetpass3)

do until(opresult.atendofstream)

excelapp.activeworkbook.worksheets("tmpシート").cells(x,1)=opresult.readline
x=x+1

loop

'****************************************************************



とりあえず、あらかじめ作成しておいたxlsのtmpシートのA1からEOFまで吐き出しまくり。

なにしろ、VBSでは、ファイル整形がしずらい。できないことはないが、メンドイ。

tmpにはいたら、後は表のセルに吐き出しなおせばよし。

ここは実際には作ってないんで、今書きます。なので、動作確認は当然してまへんよーーーー。



'****************************VBAの部分ね。*************************
Sub test()


Dim x As Integer

Dim y As Integer
Dim a As Long



x = 1
y = 1
a = 1


Do While (Sheet1.Cells(a, 1) <> "")

If Sheet3.Cells(a, 1) > 0.3333 Then 'dateで攻めてもいいよー

Sheet3.Cells(a, 1).Delete

End If

a = a + 1

Loop


a = 1 'a初期化

'7日くぎり5段で。
Do While (y < 6)


Do While (x < 8)

Sheet2.Cells(y, x) = Sheet1.Cells(a, 1)
x = x + 1
a = a + 1
Loop

x = 1 'x初期化
y = y + 1
Loop


Sheet2.Range("A1:G5").NumberFormatLocal = "[h]:mm:ss" 'セルの表示形式を左記に変更なり。



End Sub

'***********************************************************


VBAの部分は表をきれいにしようがしまいが、構文はこんな感じだろう。
sheet3がtmpシートね。
sheet2に吐き出すのね。
位置は上記構文のセルずらしてあわすといいさーー。

たぶん動くよ。ミスしてなければ。





VBSのフルソース。
'*******************************************************************

const targetpass0="D:\test\tmp.txt"
const targetpass1="D:\test\置換ソート.txt"
const targetpass2="D:\test\置換結果.txt"
const targetpass3="D:\test\結果.txt"
const targetpass4="D:\test\tmp2.txt"
const filepath="D:\test\test.xls"


set makefile=createobject("scripting.filesystemobject")
set delfile = createobject("scripting.filesystemobject")



delfile.deletefile targetpass1
delfile.deletefile targetpass2
delfile.deletefile targetpass3



makefile.createtextfile targetpass1
makefile.createtextfile targetpass2
makefile.createtextfile targetpass3





wscript.sleep 2000








'********************************ファイル置換プロシージャ********************************
function replacetest(patrn,replstr)

dim regex,str1

set reptxt = createobject("scripting.filesystemobject")'読み込みファイル
set repobjtxt=reptxt.opentextfile("D:\test\tmp.txt")

set reptxt2 = createobject("scripting.filesystemobject")'書き込みファイル
set repobjtxt2 = reptxt2.opentextfile(targetpass2,8)


set regex = new regexp
regex.pattern = patrn'検索パターン
regex.ignorecase = true


do until(repobjtxt.atendofstream)

line = repobjtxt.readline

replacetest=regex.replace(line,replstr)
repobjtxt2.writeline replacetest

loop


repobjtxt.close
repobjtxt2.close

end function

'********************************ファイル置換プロシージャ********************************












set tmp=createobject("wscript.shell")

dim tmpline
dim tmpline2
dim tmplineM
dim tmplineM2

tmplineM2="a"


'第二引数が読み取れない。
'tmp.run "cscript C:\WINDOWS\system32\eventquery.vbs /l system /fi "datetime gt 06/01/2011,7:00:00AM" /fi "id eq 6005" | sort > tmp.txt"


'0でbackground処理に回す。
tmp.run "cmd /c D:\test\イベントログ抽出.bat",0

wscript.sleep 2000



'----------------------------置換コール----------------------------------------------
dim a
a=replacetest(" 7:"," 07:")
set tmpx=createobject("wscript.shell")
'再ソート
tmpx.run "cmd /c type " & targetpass0 & " | sort > 置換ソート.txt",0

wscript.sleep 2000
'------------------------------------------------------------------------------------






tmp.run "cmd /c type " & targetpass1 & " | findstr /i 情報 > tmp2.txt" ,0


set optxt = createobject("scripting.filesystemobject")'読み込みファイル
set optxt2 = createobject("scripting.filesystemobject")'結果書き込みファイル



set objtxt=optxt.opentextfile(targetpass4)
set objtxt2 = optxt2.opentextfile(targetpass3,8)



do until(objtxt.atendofstream)

line = objtxt.readline



objtxt2.writeline mid(line,21,19)



loop



objtxt.close
objtxt2.close



'********************xls書き込み************************

dim excelapp
dim excelbook
dim x

x=1

set excelapp=createobject("excel.application")
set excelbook=excelapp.workbooks.open(filepath)

excelapp.visible=false

excelapp.activeworkbook.worksheets("tmpシート").select




set resulttext=createobject("scripting.filesystemobject")
set opresult=resulttext.opentextfile (targetpass3)

do until(opresult.atendofstream)

excelapp.activeworkbook.worksheets("tmpシート").cells(x,1)=opresult.readline
x=x+1

loop



'非表示
excelapp.displayalerts = false

'bookセーブ
excelapp.activeworkbook.saveas(filepath)

wscript.sleep 3000

'終了
excelapp.quit
set excelapp=nothing
set excelbook=nothing

'*******************************************************************


おわりー。


週はじめはやっぱりだるいね。しんどいね。
栄養ドリンクきかないち。。。

ふー次回また何かを紹介するなり。
明後日予定ーーーーー

ヾ(=・ω・=)o☆ﾊﾞｲﾊﾞｲ☆ヾ(=・ω・=)o


---------------------------------------------------------------------------------------------------------------------













レンタルサーバー 【ヘテムル】 なら、
独自ドメイン【無制限】、データベース【50 個まで】を追加費用無料で設定できます。
しかも、サーバー容量は余裕の 42.195ＧＢ！
1 つの契約でたくさんのサイトを運営したい方にぴったりのサービスです。



あなたのサイトでダウンロード販売！
その日のうちに開設可能！
初回、月々固定費用は無料！
デジタルデータなら何でも販売可能！
お試し感覚で始めてみよう！
詳しくはデジマーケットへ


急げ！新ドメインは早いもの勝ち！



チカッパプラン　詳細はこちら