こんにちは
いつもお世話になります。
現在、「ファイルの指定ダイアログ」で選択されたファイルの中身(ファイル名)
と「フォルダ指定ダイアログ(参照先)」で選択されたフォルダ(サブフォルダ含む)
内のファイルの名前を比較して、一致しているファイルを「フォルダ指定ダイアログ
(保存先)」にコピーし、一致しないファイル名を同じく「フォルダ指定ダイアログ
(保存先)」に出力するというツールを作成しています。
以下を実行させても、ファイルのコピーも出力もされないのですが、教えていただけます
でしょうか。
宜しくお願い致します。
----------------------------------------------------------------------
<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で質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) フォルダ内のワードファイルをPDFに一括変換するVBA 3 2023/06/09 16:51
- Visual Basic(VBA) VBA This Workbookモジュールを別ファイルにコピーする方法 1 2022/09/14 01:51
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/06 17:46
- Visual Basic(VBA) VBA 参照先で選んだファイルをコピーし、出力先に別名で保存したい 8 2022/05/13 20:37
- Visual Basic(VBA) VBAが止まります。 2 2022/09/02 14:02
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 複数のcsvファイルをExcelに一括変換したい 2 2023/03/03 12:44
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
ファイル名と同名のフォルダを...
-
バッチファイルで指定フォルダ...
-
Excelのハイパーリンクについて...
-
【マクロ】ファイル名の日付に...
-
ツリービューを使って、エクス...
-
集めたシートのシート名を変更...
-
Debug フォルダは消していいの?
-
エクセルのマクロについて教え...
-
Javaでフォルダ複数階層のZipフ...
-
GetAttrが原因?
-
VBAにてツリー階層表示ツールの...
-
会社のネットワーク上のファイ...
-
ExcelVBAでフォルダへのハイパ...
-
ディレクトリ名変更してコピー...
-
パス名に2バイト文字(マルチバ...
-
ThisWorkbookがあるフォルダ更...
-
Excel VBA フォルダ存在チェッ...
-
Excel VBA マクロ リストボックス
-
VBSでファイル名と同じフォルダ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
ファイル名と同名のフォルダを...
-
デスクトップの画像をhtmlに表...
-
VBA 最新のフォルダ取得
-
excelマクロ 冒頭3文字が一致す...
-
ディレクトリ名変更してコピー...
-
Excelのハイパーリンクについて...
-
VBA フォルダ名に特定の文字を...
-
フォルダにリンクを貼りたい
-
会社のネットワーク上のファイ...
-
C ファイル出力で、フォルダが...
-
フォルダを開いて、閉じるのプ...
-
同一フォルダ内の別ブックから...
-
ExcelVBAでフォルダへのハイパ...
-
パス名に2バイト文字(マルチバ...
-
フォルダ内のPDFファイル名を変...
-
多量のファイルをフォルダに自...
-
保存先のフォルダ名を指定した...
-
Access VBA で フォルダ権限...
-
【VBS】古い日付のフォルダを削...
おすすめ情報