- 締切済み
VBScriptでのファイルコピー
こんにちは いつもお世話になります。 現在、「ファイルの指定ダイアログ」で選択されたファイルの中身（ファイル名） と「フォルダ指定ダイアログ（参照先）」で選択されたフォルダ（サブフォルダ含む） 内のファイルの名前を比較して、一致しているファイルを「フォルダ指定ダイアログ （保存先）」にコピーし、一致しないファイル名を同じく「フォルダ指定ダイアログ （保存先）」に出力するというツールを作成しています。 以下を実行させても、ファイルのコピーも出力もされないのですが、教えていただけます でしょうか。 宜しくお願い致します。 ---------------------------------------------------------------------- <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>
- k1227_001
- お礼率47% (8/17)
- Visual Basic
- 回答数2
- ありがとう数0
- みんなの回答 （2）
- 専門家の回答
みんなの回答
- redfox63
- ベストアンサー率71% (1325/1856)
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 ) と言った具合で分割できます
- redfox63
- ベストアンサー率71% (1325/1856)
『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