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>
お礼
ありがとうございます! HTAにすることで解決しました!!