こんにちは
いつもお世話になります。
現在、「ファイルの指定ダイアログ」で選択されたファイルの中身(ファイル名)
と「フォルダ指定ダイアログ(参照先)」で選択されたフォルダ(サブフォルダ含む)
内のファイルの名前を比較して、一致しているファイルを「フォルダ指定ダイアログ
(保存先)」にコピーし、一致しないファイル名を同じく「フォルダ指定ダイアログ
(保存先)」に出力するというツールを作成しています。
以下を実行させても、ファイルのコピーも出力もされないのですが、教えていただけます
でしょうか。
宜しくお願い致します。
----------------------------------------------------------------------
<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件)
- 最新から表示
- 回答順に表示
No.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 )
と言った具合で分割できます
No.1
- 回答日時:
『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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
VBA 最新のフォルダ取得
-
フォームを最前面に表示したい...
-
VBA フォルダ名に特定の文字を...
-
エクセルマクロで指定フォルダ...
-
パス名に2バイト文字(マルチバ...
-
ファイル名と同名のフォルダを...
-
excelマクロ 冒頭3文字が一致す...
-
[VBS] Unicodeの文字化けを防ぎ...
-
ThisWorkbookがあるフォルダ更...
-
デスクトップの画像をhtmlに表...
-
30日前を残して過去の日付フォ...
-
VBAで、ファイルを移動する方法...
-
VB6で7-ZIPのAPIを使用した圧縮...
-
vbsで選択ダイアログを表示した...
-
ExcelVBAでフォルダへのハイパ...
-
C ファイル出力で、フォルダが...
-
ExcelのVBAでの複数階層からの...
-
ブラウザ上でエクスプローラの...
-
Downloaded Program Filesはど...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
VBA 最新のフォルダ取得
-
ファイル名と同名のフォルダを...
-
デスクトップの画像をhtmlに表...
-
Excelのハイパーリンクについて...
-
VBプロジェクトでのフォルダ構...
-
会社のネットワーク上のファイ...
-
【マクロ】ファイル名の日付に...
-
パス名に2バイト文字(マルチバ...
-
Access VBA で フォルダ権限...
-
カレントフォルダって?
-
VBA フォルダ名に特定の文字を...
-
ExcelVBAでフォルダへのハイパ...
-
C ファイル出力で、フォルダが...
-
excelマクロ 冒頭3文字が一致す...
-
保存先のフォルダ名を指定した...
-
マクロVBAのフォルダ階層別で検...
-
Excelで指定したフォルダに保存...
-
ディレクトリ名変更してコピー...
-
vbsで選択ダイアログを表示した...
おすすめ情報