「VBScript」でのファイルのコピーについて

解決済

質問者：k1227_001
質問日時：2007/11/01 13:00
回答数：2件

こんにちわ

テキストファイルに記述されている「ファイル名」とフォルダ内の
「ファイル名」を比べて一致しているものを別のフォルダにコピー
するというツールを作っています。

読込んテキストファイルの内容とフォルダ内のファイルを比較する
にはどのようにすればいいのでしょうか？

宜しくお願い致します。

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (2件)

No.1

回答者： NOBNNN
回答日時：2007/11/01 13:37

読み込んだTEXTファイルに書かれている

ファイル名がフォルダに存在するかどうかEXISTS関数　で検査し、ファイルがあれば別のフォルダにコピーするようにしては・・・

この回答への補足

NOBNNNさん

ありがとうございます。
それぞれの「参照」については以下のように作ってみたのですが、
取得した「テキストファイルのファイル名」と「参照元フォルダ内
のファイル名」の検査方法がわかりません。

下記では、「テキストファイルのファイル名」をテキストエリアに
表示するということはできたのですが、、、

参照元のサブフォルダ内のファイル名まで取得して検査し、一致した
ものを「保存フォルダ」にコピーして、一致していないファイル名は
textで「Const NON_FILE = "C:\NONList.txt"」として出力したいのですが、
こういった場合は、複数のsubなどで分けてcallした方が良いのでしょうか？

サンプルコードなどをいただけたらと思います。

以上、宜しくお願い致します。

<HAT:APPLCATION BORDER="dialog" SCROLL="no" ICON="app.ico">

<script language="VBS">
Call Window.ResizeTo(500,200)

'参照元フォルダ選択
sub inFolder()

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder( _
0, "フォルダを選択してください", 0, "ssfDeskTop")
If objFolder Is nothing Then
MsgBox("フォルダを選択されませんでした。")
Else
pathFolder = objFolder.Items().Item().Path
ifd.value = vbCr & pathFolder
Set objFolder = nothing
End If

End sub

'保存先フォルダの選択
sub outFolder()

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder( _
0, "フォルダを選択してください", 0, "ssfDeskTop")
If objFolder Is nothing Then
MsgBox("フォルダを選択されませんでした。")
Else
pathFolder = objFolder.Items().Item().Path
ofd.value = vbCr & pathFolder
Set objFolder = nothing
End If

End sub

'処理・・・orz
sub MainProc()

txOut=""
inFileName = inFile.Value
Set objFso = CreateObject("Scripting.FileSystemObject")
'ファイルの有無チェック
If objFso.FileExists(inFileName) = True Then
'書き出し処理
Set objTxIn = objFso.OpenTextFile(inFileName)
Do Until objTxIn.AtEndOfStream = True
txDisp = objTxIn.ReadLine()
txOut = txOut & txDisp & vbCr
Loop
disp.value = txOut
'ファイルが無いとき
Else
MsgBox("ファイルがありません")
End If
End Sub

</script>

</head>

<body>

参照ファイル：
<input type="file" id="inFile" size="40">
<br />

参照フォルダ：
<input type="text" id="ifd" size="40">
<input type="button" id="btn1" value="参照..">

<script for="btn1" event="onClick" language="VBS">
call inFolder()
</script>
<br />

保存フォルダ：
<input type="text" id="ofd" size="40">
<input type="button" id="btn2" value="保存.." >

<script for="btn2" event="onClick" language="VBS">
call outFolder()
</script>
<br />

<input type ="button" id="btn3" value="実行">

<script for="btn3" event="onClick" language="VBS">
call MainProc()
</script>

<textarea name="disp" cols="60" wrap="VIRTUAL" rows="20">

補足日時：2007/11/01 21:16

通報する

- 0
- 件

通報する

No.2ベストアンサー

回答者： himajin100000
回答日時：2007/11/01 20:37

C:\Data\Administrator\Others\Oshiete_Goo\Quarter4\Q3479988

【vbsとファイル名リストのテキストはUTF-16LE(WindowsではUnicodeと略されることが多いが,これは文字符号化形式の名称ではない)でなければならない。これが解らず忘れて数十分悩んだ。】

=============Q3479988A.vbs================
Option Explicit

'定数。意味は自分で調べること。

Const TristateTrue = -1
Const TristateFalse = 0
Const TristateUseDefault = -2

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

'実際には以下はカレントディレクトリから引いてくるとか,
'コマンドライン引数として受け取るのが妥当だろうな。

Dim ListFilePath 'ファイル名のリストの書かれたファイルのあるパス
Dim ListFileName'ファイル名のリストの書かれたファイルのファイル名

ListFilePath = "C:\Data\Administrator\Others\Oshiete_Goo\Quarter4\Q3479988"
ListFileName = "Q3479988A.txt"

Dim ListFile '(初期値なし)
Dim CurrentFileName '(初期値なし)
CurrentFileName = ""

Dim ComparedPath '実際のファイルがあるパス
Dim ComparedFiles 'ファイルオブジェクトのリスト(初期値なし)
Dim ComparedFile

ComparedPath = "C:\Data\Administrator\Others\Oshiete_Goo\Quarter4\Q3479988\data"

Dim DestinationPath '一致したときに移動するパス。
DestinationPath = "C:\Data\Administrator\Others\Oshiete_Goo\Quarter4\Q3479988\dest"

Dim FSO

Set FSO = Wscript.CreateObject("Scripting.FileSystemObject")

Set ListFile = FSO.OpenTextFile(ListFilePath & "\" & ListFileName,ForReading,false,TristateTrue)

Set ComparedFiles = FSO.GetFolder(ComparedPath).Files

On Error Resume Next

Do While Not ListFile.AtEndOfStream

Dim i
CurrentFileName = ListFile.ReadLine

For Each ComparedFile in ComparedFiles

'Existsを使わない理由は,テキストファイルにC:\とか
'..\..\..\..\..\Windows\System32\notepad.exeとか
'書かれているかもしれないから。
'これらは無条件でヒットしない
'どうしても使いたいなら,指定されたフォルダと同じフォルダかを
'きちんとチェックする必要がある

'ショートファイルネームについては考慮しない
If ComparedFile.Name = CurrentFileName Then
'後半は上書きフラグ。
ComparedFile.Copy DestinationPath & "\" & CurrentFileName,false
Else

End If
ComparedFile.Close
Set ComparedFile = Nothing

Next

Loop

On Error Goto 0

Set ComparedFiles = Nothing
ListFile.Close
Set ListFile = Nothing
Set FSO = Nothing

Msgbox("完了") 'メッセージ出しておかないと？？？になる

=================Q3479988A.txt===============
b.txt
d.txt
C:\Book.xls
..\Q3479988.txt
=================dataフォルダ==============
a.txt
b.txt
c.txt
d.txt
=================destフォルダ===============
(元々空)だｔｔが
実行後
b.txtとd.txtが出来ている

この回答への補足

himajin100000　さん

ありがとうございます。読み込むtxtファイルには「12345.gif」
や「123456.GIF」というgifファイル名のみになるため、できれば
再帰処理でファイル名を取得したいと思っています。

下記のように記述し「ルートフォルダ内のファイル名」と
「サブフォルダ名」の取得はできるのですが、やはりサブ
フォルダ内のファイル名取得ができません。

以上、宜しくお願い致します。

sub SubFoleder(inFolderName)

txOut=""
inFolderName = ifd.value
Set objFso = CreateObject("Scripting.FileSystemObject")

'ファイルの有無チェック
If objFso.FolderExists(inFolderName) = True Then

'フォルダのオブジェクトとコレクションを得る
Set objFolder = objFso.GetFolder(inFolderName)
Set colFiles = objFolder.Files
Set colFolders = objFolder.SubFolders

'inFolder内のファイル処理
For Each objFile In colFiles
txOut = txOut & objFile.Name & vbCr
Next

'inFolder のSubFolder 内のファイル処理
For Each objSubFolder In colFolders
'↓サブフォルダ名の取得
txOut = txOut & objSubFolder.Name & vbCr

'Call SubFoleder(objSubFolder)
disp.value= txOut &vbCr
Next

If objFolder.IsRootFolder Then
parentFolder = "なし"
Else
parentFolder = objFolder.ParentFolder
End If
'ファイルが無いとき
Else
MsgBox(inFolderName&"フォルダはありません")
End If
End Sub