AIと戦って、あなたの人生のリスク診断 >>

こんにちは

以前も質問させていただいたのですが、再帰処理が上手くいかないので教えてください。

フォルダ指定ダイアログで取得したフォルダのサブフォルダ内のファイル名を
取得いたいのですが、Sub iFolder(inFolderName)内の inFolderName = ifd.valueの
部分で「Out of memory」となってしまいます。

参照ファイル内のファイル名と参照フォルダ(サブフォルダ含む)内の
ファイル名を比較して一致しているファイルを保存先フォルダにコピー
/一致しないファイル名をテキストで出力をいうことをしたいと思っています。

参照ファイルの中身は「123.jpg」や「456.JPG」などのファイル名だけになります。

以上、宜しくお願い致します。

<html>
<head>
<title>テスト</title>
<HAT:APPLCATION BORDER="dialog" SCROLL="no" ICON="app.ico">

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

'参照フォルダをテキストに表示
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
Set objFso = CreateObject("Scripting.FileSystemObject")

If objFso.FileExists(inFileName) = True Then
'書き出し処理
Set objTxIn = objFso.OpenTextFile(inFileName)
Do Until objTxIn.AtEndOfStream = True
txDisp = objTxIn.ReadLine()
txOut = txOut & txDisp & vbCr
Loop
disp1.value = txOut
'ファイルが無いとき
Else
MsgBox("ファイルがありません")
End If
call iFolder(inFolderName)
End Sub

'サブフォルダ読込-------------------------------------------
Sub iFolder(inFolderName)
Dim fsoFolder
Dim fsoSubFolder
Dim fsoFile


inFolderName = ifd.value
Set objFso = CreateObject("Scripting.FileSystemObject")


'フォルダオブジェクト取得
Set fsoFolder = objFso.GetFolder(inFolderName)

'フォルダ内/ファイルループ
For Each fsoFile In fsoFolder.Files
'ログに出力
disp2.value = fsoFile.Name
Next

'フォルダ内/サブフォルダループ(サブフォルダが不要なら、このループは不要)
For Each fsoSubFolder In fsoFolder.SubFolders
'サブフォルダで再帰
Call iFolder(fsoSubFolder)
Next
End Sub

</script>

</head>

<body>

参照ファイル:
<input type="file" id="inFile" size="40">


<br />
参照フォルダ:
<input type="text" id="ifd" size="40">
<input type="button" id="fd1" value="参照..">

<script for="fd1" event="onClick" language="VBS">
call inFolder()
</script>

<br />
保存フォルダ:
<input type="text" id="ofd" size="40">
<input type="button" id="fd2" value="保存.." >

<script for="fd2" event="onClick" language="VBS">
call outFolder()
</script>
<br />

<input type="button" id="btn" value="表示">

<br />

<textarea name="disp1" cols="30" wrap="virtual" rows="20"></textarea>
<textarea name="disp2" cols="30" wrap="virtual" rows="20"></textarea>

</body>
</html>

このQ&Aに関連する最新のQ&A

A 回答 (3件)

disp2.value = fsoFile.Nameとしてますが これだと常に一番最後に検索されたファイル名だけになると思います



disp2.value = disp2.value + fsoFile.Name + vbCrLf
と言った具合にしないと追加されてはいかないでしょう

disp1に関しても同じことが言えると思いますよ

この回答への補足

redfox63 さん

ありがとうございます。サブフォルダの中身も表示できました。

初歩的な質問で申し訳ありませんが、共有サーバ内にあるフォルダを指定した
際には「パスが見つかりません」とのことでルートディレクトリ内のファイル名
しか取得できませんでした。

今の記述方法では、ローカルマシンでし動作しないのでしょうか?

以上、宜しくお願い致します。

補足日時:2007/11/06 16:44
    • good
    • 0

ネットワーク共有されたフォルダーでも可能ですよ


パスワード保護がある場合は先に人間さんが接続してからなら上手くいくようです

自動化も可能だったはずですが ちょっと資料が見つかりませんでした
m(__)m
    • good
    • 0
この回答へのお礼

redfox63さん

こんばんわ。調べていただいてありがとうございます。
エラーの「パスが見つかりません」と指定箇所のSet fsoFolder =
objFso.GetFolder(inFolderName)で調べてみます。

ローカルでは動いているので、先に参照ファイルで取得したファイル名
と参照先フォルダから取得したファイル名を検査して一致したものを
保存先フォルダにコピー、一致しないファイル名をテキストで保存先に
出力というのを考えてみます。

If objFso.FolderExistsで躓いていますが、がんばってみます。

お礼日時:2007/11/06 23:44

iFolderの引数 inFolderNameにifd.valueを毎回代入してしまっては同じフォルダーを参照してしまうことになりませんか



したがって再帰で呼び出されても inFolderNameは無視され常にifd.valueで検索を掛けているため 無限ループになって メモリーが足りなくなるのだと思います

この1行をコメントアウトしてみましょう
または
if inFolderName ="" then inFolderName = idf.value
と言った具合にするかですが …

この回答への補足

redfox63 さん

ありがとうございます。
'inFolderName = ifd.value をコメントアウトした場合、プロシジャーの呼び出し、
または、引数が不正です。とエラーになってしまいます。

また、お教えいただきました「if inFolderName ="" then inFolderName = ifd.value」を
追加するとエラーは表示されせんが「Thumbs.db」のみ表示され、サブフォルダ内のファイル名の
取得はできませんでした。

他に何か方法がないか教えていただけますでしょうか。

宜しくお願い致します。

補足日時:2007/11/06 15:19
    • good
    • 0

このQ&Aに関連する人気のQ&A

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

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QVBS サブフォルダの再帰処理について

VBScriptでファイルリストを出力しようと考えています。
そこでフォルダ内のファイルを再帰的に検索したいのですが、上手くいきません。

C:\A\B\C\D\○○.txt
C:\A\BB\C\D\××.txt
C:\A\BBB\C\D\△△.txt

のようにB,BB,BBBの部分のみ可変にしたいのです。
例えば C:\A\B\CC\D\○○.txt C:\A\B\CCC\D\○○.txt のような
B以外のフォルダのサブフォルダについては再帰検索はいきたくありません。
(A,C ,D については引数で与えようと考えています。)

よいロジックはないでしょうか?
ご存知の方がいらっしゃいましたらぜひ教えてください。

出力形式は
ファイル名,作成日時

以下 色々参考にして作成したプログラム。
これだと指定フォルダ以下すべて検索にいってしまいます(-_-;)
---------------------------------------------------------------
Dim fso
Dim folder
Set fso = CreateObject("Scripting.FileSystemObject")
Dim pass
pass ="C:\" & args.item(0) & "\"
Dim subFolder

For Each subFolder In folder.SubFolders
ShowSubfolders FSO.GetFolder(pass)
Next

Sub ShowSubFolders(Folder)

Dim file
For Each file In folder.Files
WScript.Echo _
file.Name & "," & _
file.DateCreated
Next
For Each subFolder In folder.SubFolders
ShowSubFolders subFolder
Next

End Sub

VBScriptでファイルリストを出力しようと考えています。
そこでフォルダ内のファイルを再帰的に検索したいのですが、上手くいきません。

C:\A\B\C\D\○○.txt
C:\A\BB\C\D\××.txt
C:\A\BBB\C\D\△△.txt

のようにB,BB,BBBの部分のみ可変にしたいのです。
例えば C:\A\B\CC\D\○○.txt C:\A\B\CCC\D\○○.txt のような
B以外のフォルダのサブフォルダについては再帰検索はいきたくありません。
(A,C ,D については引数で与えようと考えています。)

よいロジックはないでしょうか?
ご存知の方がいらっ...続きを読む

Aベストアンサー

@IT:Windows TIPS -- Tips:ファイルの一覧情報リストを取得する
http://www.atmarkit.co.jp/fwin2k/win2ktips/310filelist/filelist.html

こちらが参考になると思います。

QDoEvents関数って何?

こんにちは。

VBAやプログラミングに詳しい皆様に
教えていただきたい質問があります。

cells(1,1)からcells(5000,1)までの値を消去するときに
処理の進行状況を表示するためにuserform上にプログレスバーを表示したいと思います。

そこで下記のようなコードを入力しました。

userform1.show
for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
next i
unload userform1

しかしこれだとuserformの背景が真っ白になってしまい
ラベルの文字も消えてしまいます。
そこで「EXCEL VBA パーフェクトマスター」という本を見たら

for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
DoEvents
next i
unload userform1
と入力すれば解決することがわかりました。

しかし「DoEvents」についてあまり詳しく書いていなかったのでDoEvents関数をヘルプで見ると、
「発生したイベントがオペレーティング システムによって処理されるように、プログラムで占有していた制御をオペレーティング システムに渡すフロー制御関数です。」

と書いてあるのですが正直、書いてあることがよくわかりません。

どなたかDoEvents関数について、
もう少しわかりやすく教えていただけませんか。
それから、最初に書いたコードで実行すると
ユーザーフォームの背景が真っ白になってしまう原因も
教えていただけませんか?

よろしくお願いいたします。

こんにちは。

VBAやプログラミングに詳しい皆様に
教えていただきたい質問があります。

cells(1,1)からcells(5000,1)までの値を消去するときに
処理の進行状況を表示するためにuserform上にプログレスバーを表示したいと思います。

そこで下記のようなコードを入力しました。

userform1.show
for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
next i
unload userform1

しかしこれだとuserformの背景が真っ白になってしまい
ラベルの文字も消えてしまいます。
そ...続きを読む

Aベストアンサー

簡単に言うと、
OS に制御を渡すってことです。(ヘルプそのまんま)
時間が掛かるループ処理などの場合、ループが終わるまで制御は独占されてしまいます。
ですのでループ中は OS や Excel そのものにも再描画をさせる暇さえ与えません。
途中に DoEvents を入れると制御が OS に渡るので、OS は溜まっていた処理をそこで行うことができます。
結果、フォームの再描画などが行われることになります。

注意点ですが、
Private Sub CommandButton1_Click()
  Dim i As Long

  For i = 1 To 50000
    DoEvents
    Cells(i,1) = ""
  Next i
End Sub

Private Sub CommandButton2_Click()
  MsgBox "hoge"
End Sub

っていうフォームのコードがあった場合、
DoEvents を入れることによって、ループ中にユーザーがCommandButton2 を押すことによって CommandButton2 のクリック イベントも動いちゃいます。
CommandButton1 のクリック イベントではループの前に
CommandButton1.Enabled = False
CommandButton2.Enabled = False
を書いてフォーム上の CommandButton を無効にしておき、ループが終わったら
CommandButton1.Enabled = True
CommandButton2.Enabled = True
と書いて CommandButton を有効に戻してください。

これを工夫すれば、CommandButton2 で CommandButton1 のループを途中キャンセルする処理もすることができます。

Private Canceled As Boolean

Private Sub CommandButton1_Click()

  CommandButton2.Enabled = False

  Dim i As Long
  For i = 1 To 50000
    DoEvents

    If Canceled = True Then
      MsgBox "キャンセルしました"
      Exit Sub
    End If

    Cells(i, 1).Value = ""
  Next i
End Sub

Private CommandButton2_Click()
  Canceled = True
End Sub



コードの行頭にあるスペースは見易さのために全角スペースで作成していますので、これをこのままコピペするとエラーになるかもしれません。
コピペするなら行頭の全角スペースを半角スペースに直してください。

簡単に言うと、
OS に制御を渡すってことです。(ヘルプそのまんま)
時間が掛かるループ処理などの場合、ループが終わるまで制御は独占されてしまいます。
ですのでループ中は OS や Excel そのものにも再描画をさせる暇さえ与えません。
途中に DoEvents を入れると制御が OS に渡るので、OS は溜まっていた処理をそこで行うことができます。
結果、フォームの再描画などが行われることになります。

注意点ですが、
Private Sub CommandButton1_Click()
  Dim i As Long

  For i = 1 To 50000
...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QVBでファイルが開かれているかどうかを確認したい

お疲れ様です。

Open ステートメントで開いたファイルが、閉じていなければ閉じると言う処理をしたいのですが、ファイルが開きっぱなしかどうかを確認するには、どんな方法があるのでしょうか?

よろしくお願いします。

Aベストアンサー

こんにちは

もう一度同じファイルを同じファイルNo.(#1)で
開きに行くと、
開きっぱなしなら“すでに開いています”とエラーになって
閉じていたら、エラーがないので
判断出きるはずです。

QVBSでエクセル内の行数を取得する方法

VBS初心者です。よろしくお願い致します。

VBSでエクセル内のデータの行数を取得する方法を教えて下さい。

セル1 セル2 セル3 セル4
123   234   875   ads
あい  うえ  458   444

上記がエクセルの内容だとしたら、3行という結果が欲しいのです。

どうぞよろしくお願い致します。

Aベストアンサー

>自分でエクセル内のデータを1行にして再度実行すると、値はやはり4と返してきます
書式か何か残ってるんじゃないでしょうか

>objExcel.Visible = false
true にして実行してみると判るかと思いますが、
エクセルを非表示するという設定を(明示的に)しています。

QVBScriptから指定URLを開く方法

 ある特定のWebページをVBScriptから開きたいのですが方法が探せませんでした。VBScriptからWebページを開く方法、もしくはhttp putを行う方法を教えてください。よろしくお願いします。

Aベストアンサー

こんなので、どうでしょうか?

Set objIE = Wscript.CreateObject("InternetExplorer.Application")
objIE.Navigate2 "http://www.goo.ne.jp/"
objIE.Visible = TRUE
Set objIE =Nothing

Qポートの80と443

こちらのサービス(https://secure.logmein.com/)を利用すると、インターネットを見られるサーバーのポートの80と443が空いていればルータやファイアウォールに特段の設定なく外部からサーバーを操作できるそうですが、逆にサーバーのポートの80や443を空けることには何か危険性があるのでしょうか。

Aベストアンサー

ポート80は一般的なHTTP、ポート443はHTTPSです。
この2つのポートがあいていなければインターネット接続(WEBブラウジング)は出来ません。
ですから、ほとんどのファイアウォールでこのポートは開いています。(インターネット接続を制限している社内LANでは当然閉じていますが)

ちなみに、よく使うポートとしてはFTPで20、21、SMTP(送信メール)で25、受信メールPOP3で110あたりです。セキュリティポリシー上、この辺は制限される事も多いですが、HTTP 80、HTTPS(暗号化用)443は通常閉じません。


危険性?
WEBプロトコルを使ってFTP的なファイル転送(WebDAV)やVPN等も出来るようになっています。当然そこにはある種の危険はつきものですが、WEBブラウジングに伴う危険と大きく変わりません。ウィルス等に感染していればこの2つのポートだけでも相当危険でしょうね。

参考まで。

Q【SQLServer】IS NULLのパフォーマンス

お世話になっております。SQLSERVER初心者です。

NULLを含む列COL1を検索条件に入れる場合、
パフォーマンスの観点から

WHERE COL1 IS NULL とするのではなく
WHERE ISNULL(COL1,'') = '' とするよう有識者から言われました。

そこで質問なのですが、

(1)IS NULL は基本的に上記のように変換したほうが早くなるのですか?
(2)COL1にもしインデックスが設定されていたとしても、上記の場合だとどちらも効かないですよね?

詳しい方おしえてください。
よろしくおねがいします。

Aベストアンサー

試しにこちらの適当なテーブルに索引をつけて検索してみました。

(1)WHERE COL1 IS NULL
INDEX SEEKになりました

(2)WHERE ISNULL(COL1,'') = ''
INDEX SCANになりました

INDEX SEEKなので(1)の方が効率がよさそうです。
ManagementStudioでSQL実行時に「実際の実行プランを含める」のオプションつきで実行してみてください。

でも、(2)は長さ0の空文字も対象にするから(1)と(2)は結果が変りますよね。このことを考慮してますか?

※長さ0の文字列とNULLを区別するかどうかはDBによって異なります。

QVBSで変数の宣言はできないのですか?

VBSで、

Dim a As String
a = InputBox("MsgBoxに表示する値を入れてください。", , "test")
MsgBox a

と文章を作って、test.vbsで保存しました。
するとエラーになります。

Dim a As Stringの部分を消すと、問題なく作動します。

もしくは、

Dim a
a = InputBox("MsgBoxに表示する値を入れてください。", , "test")
MsgBox a

でも正常に動きます。
VBSで変数の宣言はできないのでしょうか?

Aベストアンサー

こっちの方がより面白いか。
自動型変換の便利さと危うさですね。

dim a
msgbox typename(a)
a=1
msgbox "a= " & a & " typename= " & typename(a)

a=a*100000
msgbox "a= " & a & " typename= " & typename(a)

a=a*0.1
msgbox "a= " & a & " typename= " & typename(a)

a= a & "b"
msgbox "a= " & a & " typename= " & typename(a)

a=a*1

QVBS実行時エラー オブジェクトがありません 回避方法について

タイトルの件ですが、現在CSVよりIDとPWを読み込み、Webページに自動ログインできるVBSを作成しております。
ネットの情報を頼りに下記ソースを作成し、自動ログインできるところまでは達成しました。
しかしながら、一回目の実行時はいいのですが、二回目以降時間を置かずにVBSを起動すると
エラーが発生します。(IEは起動し、ログイン自体は出来ます)
本エラーの回避方法をご教授願えませんでしょうか。

エラーの発生場所は objIE.Document.getElementsByName("username")(0).Value = SiteID
あたりだとは思うのですが、何が原因かがわからなく。。

○エラーメッセージ
エラー:オブジェクトがありません。:'objIE.Document.getElementByName(...)(...)'
コード:800A01A8
ソース:Microsoft VBScript 実行時エラー

○コード
'Option Explicit

Dim tmp 'CSV格納
Dim tmp2 'CSV分割
Dim SiteArray(10) 'ID,PW,URL格納
Dim SiteURL 'URL格納
Dim SiteID 'ID格納
Dim SitePW 'PW格納

Dim i
dim objFSO
dim stmCsvFile

'URL,ID,PWをCSVより読込
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set stmCsvFile = objFSO.OpenTextFile("C:\Users\***\Desktop\login.csv")

Do Until stmCsvFile.AtEndOfLine = True
tmp = stmCsvFile.readline
tmp2 = Split(tmp, ",")
SiteArray(i) = tmp2(1)
i = i + 1
Loop

stmcsvfile.Close


'URL,ID,PWを格納
SiteID = SiteArray(1)
SitePW = SiteArray(2)
SiteURL = SiteArray(0)

'---------- ひらく

Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True
objIE.Navigate SiteURL
Do Until objIE.busy = False And objIE.readyState = 4 : Loop '待ち合わせ

'---------- ID/PASSの入力

objIE.Document.getElementsByName("username")(0).Value = SiteID
objIE.Document.getElementsByName("password")(0).Value = SitePW

'---------- SUBMIT

objIE.Document.getElementsByName("login_form")(0).Submit
Do Until objIE.busy = False And objIE.readyState = 4 : Loop '待ち合わせ

'----------

宜しくお願い致します。

タイトルの件ですが、現在CSVよりIDとPWを読み込み、Webページに自動ログインできるVBSを作成しております。
ネットの情報を頼りに下記ソースを作成し、自動ログインできるところまでは達成しました。
しかしながら、一回目の実行時はいいのですが、二回目以降時間を置かずにVBSを起動すると
エラーが発生します。(IEは起動し、ログイン自体は出来ます)
本エラーの回避方法をご教授願えませんでしょうか。

エラーの発生場所は objIE.Document.getElementsByName("username")(0).Value = SiteID
あたりだ...続きを読む

Aベストアンサー

こんにちは。

>コメント頂いた箇所を下記の通り処理を変更しましたが現象はほぼ変わりませんでした。

#1で私の書いた、IsObjectは一般論ですが、個別の問題になるとかなり話は込み入ってしまうから、やめておいたことですが、なんといっても、VBSで、どのように開発しているかは分かりませんが、そのオブジェクトのプロパティとか、確認をして開発したのでしょうか。

>Set upw =objIE.Document.getElementsByName("password")
の時点で、upw を確認できない状態ですと、
upw(0) という「添字(index)」があるかどうかさえ確認できませんよね。
その辺りはどうなんでしょうか?それで、Length プロパティを調べるように書いたわけです。

ふつう、例えば、ここの「教えて!goo」なんかでも、IDとパスワードは、きちんと、[ID(uname, pass)]を持っています。そしてIDには、添字は存在しません。

VBAがあれば、VBEditorのローカルウィンドウで、そのプロパティを確認していただくしかないと思います。もしかしたら、最初からとれていないのかもしれません。

こんにちは。

>コメント頂いた箇所を下記の通り処理を変更しましたが現象はほぼ変わりませんでした。

#1で私の書いた、IsObjectは一般論ですが、個別の問題になるとかなり話は込み入ってしまうから、やめておいたことですが、なんといっても、VBSで、どのように開発しているかは分かりませんが、そのオブジェクトのプロパティとか、確認をして開発したのでしょうか。

>Set upw =objIE.Document.getElementsByName("password")
の時点で、upw を確認できない状態ですと、
upw(0) という「添字(index)」があるか...続きを読む


人気Q&Aランキング