プロが教える店舗&オフィスのセキュリティ対策術

こんにちは

いつもお世話になります。

現在、「ファイルの指定ダイアログ」で選択されたファイルの中身(ファイル名)
と「フォルダ指定ダイアログ(参照先)」で選択されたフォルダ(サブフォルダ含む)
内のファイルの名前を比較して、一致しているファイルを「フォルダ指定ダイアログ
(保存先)」にコピーし、一致しないファイル名を同じく「フォルダ指定ダイアログ
(保存先)」に出力するというツールを作成しています。

以下を実行させても、ファイルのコピーも出力もされないのですが、教えていただけます
でしょうか。

宜しくお願い致します。

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

<html><head>
<script language="VBScript">
'Call Window.ResizeTo(500,200)

Set objFso = CreateObject("Scripting.FileSystemObject")

'テキストファイル吐き出し場所
Const LIST_FILE = "C:\Documents and Settings\All Users\デスクトップ\NonFile.txt"

'色々宣言
Dim objFso
Dim inFolderName
Dim outFolderName
Dim inFileName

Dim objTxIn
Dim ListFile
Dim CurrentFileName

'色々定数
Const TristateTrue = -1
Const TristateFalse = 0
Const TristateUseDefault = -2

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


'参照フォルダをテキストに表示
'------------------------------------------------------------
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


'------------------------------------------------------------
Sub btn_onClick

'ファイルの有無チェック
txOut=""
inFileName = inFile.Value
outFolderName = ofd.value

If objFso.FileExists(inFileName) = True Then

Set ListFile = objFso.OpenTextFile(inFileName,ForReading,false,TristateTrue)

'ファイルが無いとき
Else
MsgBox("ファイルが選択されていません。")
End If

Call iFolder(inFolderName)

MsgBox("完了")
End Sub


'サブフォルダ内ファイル検査→有 コピー/無 テキスト出力
'------------------------------------------------------------
Sub iFolder(inFolderName)

CurrentFileName=""

'フォルダオブジェクト取得
outFolderName = ofd.value
If inFolderName ="" then inFolderName = ifd.value

Set fsoFolder = objFso.GetFolder(inFolderName)
On Error Resume Next

CurrentFileName = ListFile.ReadLine

For Each fsoFile In fsoFolder.Files
If fsoFile.Name = CurrentFileName Then
fsoFile.Copy outFolderName,CurrentFileName,false

Else
set NoFile = objFso.CreateTextFile(LIST_FILE,True)
NoFile.WriteLine(CurrentFileName)
NoFile.Close

End If
fsoFile.Close
Set fsoFile = Nothing

Next

For Each fsoSubFolder In fsoFolder.SubFolders
Call iFolder(fsoSubFolder)

Next
End Sub

</script>
</head>

A 回答 (2件)

ReadAllで読み込むと 全ての行がつながった内容になると思います


たとえば
a123.jpg
b456.bmp
c789.gif
と言った内容のファイルの場合
txtIn = objTxt.ReadAll()
とすると txtInは
a.123.jpg + vbcrlf + b456.bmp + vbcrlf + c789.gif + vbcrlf
といった具合だと思います
これでは 期待した結果にならないだろうと思います

Split関数で ファイル名ごとに切り出して使うなどの工夫が必要でしょう
dim arFileName
arFileName = Split(txtIn, vbcrlf )
と言った具合で分割できます
    • good
    • 0

『On Error Resume Next』をコメントアウトして エラー無く動作するのか確認します



どうしても エラートラップで切り抜けなくては仕方が無い部分のみに
On Error Resume Next と On Error Goto 0 を記述しましょう

FolderオブジェクトまたはFileオブジェクトのCopyメソッドの引数は2つですよ
CopyFileメソッドなら引数は3つですが 指定する親オブジェクトは FSOオブジェクトです

この回答への補足

redfox63 さん

お返事が遅くなり申し訳ありません。
「On Error Resume Next」をコメントアウトするとエラーで引っかかるため、
何点か書き直しコピーをすることはできるようになりました。ありがとうございました。

ただ、読込んだテキスト内のファイル名と指定したフォルダ内にあるファイル名を
比較して一致しているものをコピーということができませんでした。
<script language="VBScript">
'Call Window.ResizeTo(500,200)

Set objFso = CreateObject("Scripting.FileSystemObject")

'テキストファイル吐き出し場所
Const LIST_FILE = "C:\Documents and Settings\All Users\デスクトップ\NonFile.txt"

'色々定数
Const TristateTrue = -1, TristateFalse = 0, TristateUseDefault = -2
Const ForReading = 1 ,ForWriting = 2, ForAppending = 8

'色々宣言
Dim objFso, objTxIn, objTxT
Dim inFolderName 'コピー元フォルダ
Dim outFolderName 'コピー先フォルダ
Dim inFileName '読み込みテキスト

'中略'

'[表示]ボタンクリックで開始される処理
'------------------------------------------------------------
Sub btn_onClick

'ファイルの有無チェック

inFileName = inFile.Value
outFolderName = ofd.value

If objFso.FileExists(inFileName) = True Then

'ログファイルがあったら削除
If objFso.FileExists(LIST_FILE) Then
Call objFso.DeleteFile(LIST_FILE)
End If

'読込テキストファイルの準備
Set objTxT = objFso.OpenTextFile(inFileName)
txIn = objTxT.ReadAll()

'ファイルが無いとき
Else
MsgBox("ファイルが選択されていません。")
End If
  Call iFolder(inFolderName)

MsgBox("完了")
End Sub


'サブフォルダ内ファイル検査→有 コピー/無 テキスト出力
'------------------------------------------------------------
Sub iFolder(inFolderName)

'フォルダオブジェクト取得
outFolderName = ofd.value
If inFolderName ="" then inFolderName = ifd.value
Set fsoFolder = objFso.GetFolder(inFolderName)

'フォルダ内/ファイルループ
For Each fsoFile In fsoFolder.Files

If txIn = fsoFile.Name Then
objFso.CopyFile fsoFile.Path, outFolderName & "\"
Else

'NonFileの準備
Set objTxIn = objFso.OpenTextFile(LIST_FILE, 8, True,0)
objTxIn.WriteLine()
objTxIn.close
End If

Next
'フォルダ内/サブフォルダループ
For Each fsoSubFolder In fsoFolder.SubFolders
' サブフォルダで再帰
Call iFolder(fsoSubFolder)
Next
End Sub

補足日時:2007/11/09 10:15
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!