2007年5月6日日曜日

dts actveX スクリプト ファイル名の動的変更 削除リネーム

as 転送ファイルの動的変更 テキストファイル操作

転送ファイルを動的に変えたいニーズが出ることがあります
asのファイル名を xxxx0705などと年月付にしているものを定期的にsqlserverに転送蓄積する場合や
日付を指定してサイズを抑えて転送したい場合です
excel vbaのサンプルですが、dts のactiveX の記述にも function main ~ end functionの間に書けばそのまま使えます
特定の行だけ更新がかけられればいいんですが、方法が分からないので別ファイルに書き出し、リネームという方法をとっています

Sub ttochg()
Dim oFSO
Dim x
Dim strLine
Dim strFilename

'as 転送ファイル ttoの抽出部分を書き換える
'6行目と7行目をcellで指定した日付に変える
'書き出すために別ファイルを作る
' instantiate the Scripting Object
Set FSO = CreateObject("Scripting.FileSystemObject")
strfile1 = "C:\Documents and Settings\aco\デスクトップ\ruisk.TTO"
strfile2 = "C:\Documents and Settings\aco\デスクトップ\ruisk2.TTO"
start01 = Cells(2, 2)
'dts グローバル変数を使う場合
'ymm=dtsGlobalVariables("年月")
end01 = Cells(2, 3)
ymdd = start01
GoSub chgdate
ymdm1 = ymdm
ymdd = end01
GoSub chgdate
ymdm2 = ymdm

'openスイッチ 1 input ,2 output ,3 append
' true/false 存在しない場合作成
Set f1 = FSO.OpenTextFile(strfile1, 1, False)
Set f2 = FSO.OpenTextFile(strfile2, 2, True)

' Open the file
a = 1
Do Until f1.AtEndOfLine
buf = f1.Readline
If a = 6 Then buf = "WHERE rui13 like 'H%' and rui02>=" & ymdm1
If a = 7 Then buf = "WHERE and rui02 <=" & ymdm2
f2.writeline buf
a = a + 1
Loop
f1.Close
f2.Close

Exit Sub

chgdate:
ymdm = Mid(Format(Year(ymdd), "0000"), 3, 2) + _
Format(Month(ymdd), "00") + Format(Day(ymdd), "00")

Return
End Sub
'--------------------------------------------------------------------------------------
Sub ttodel()
Dim oFSO
Dim x
Dim strLine
Dim strFilename
'ruiskを削除してruisk2をruiskにリネームする
' instantiate the Scripting Object
Set FSO = CreateObject("Scripting.FileSystemObject")
strfile1 = "C:\Documents and Settings\aco\デスクトップ\ruisk.TTO"
strfile2 = "C:\Documents and Settings\aco\デスクトップ\ruisk2.TTO"

ingRet = FSO.deletefile(strfile1)
ingRet = FSO.movefile(strfile2, strfile1)


Set FSO = Nothing
End Sub

0 件のコメント:

コメントを投稿