Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

17897 / 76807

←次へ　｜　前へ→


	【64358】Re:Excel2007でFileSearchエラー

かみちゃん

- 10/1/31(日) 14:13 -


	引用なし

	パスワード

こんにちは。かみちゃん　です。

> 動くには動くんですが、いまいちです。

TextBox1_Changeイベントで動かすことが適当かどうかが疑問ですが、

> 一つの拡張子しか指定出来ない。
> '↓一度シートにロードしてからListBoxに張付けていますが、直接
> 'ListBoxにロードできないものか？

これらについて、対応するとすれば、一例として、以下のように修正します。

Option Explicit
Private g_strEXT As String
Dim vntFile() As Variant '★

Private Sub TextBox1_Change()
　Dim objFSO As FileSystemObject
　Dim cntFound As Long
　
　Set objFSO = New FileSystemObject

　g_strEXT = UCase("*.jpg;*.bmp;*.tif;*.gif;*.xls") '★

　cntFound = Sample_FileSearch_SUB(objFSO, objFSO.GetFolder(Trim(TextBox1.Text)), GYO, cntFound) '★
　
　With ListBox1
　　.Clear
　　If cntFound > 0 Then '★
　　　.List = vntFile '★
　　　MsgBox "ファイルがありました" '★
　　Else '★
　　　MsgBox "ファイルがありませんでした" '★
　　End If '★
　End With
End Sub

Function Sample_FileSearch_SUB(objFSO As FileSystemObject, _
　　　　　　　　　　　　　　　　　 ByVal objFolder As Folder, _
　　　　　　　　　　　　　　　　　 GYO As Long, cntFound As Long) As Long '★
　Dim objFile As File
　Dim v As Variant '★
　Dim i As Long '★
　
　v = Split(g_strEXT, ";") '★
　For Each objFile In objFolder.Files
　　With objFile
　　　For i = 0 To UBound(v) '★
　　　　If UCase(.Name) Like v(i) Then '★
　　　　　ReDim Preserve vntFile(cntFound) '★
　　　　　vntFile(cntFound) = .Name '★
　　　　　cntFound = cntFound + 1
　　　　　Exit For '★
　　　　End If '★
　　　Next '★
　　End With
　Next objFile
　
　Sample_FileSearch_SUB = cntFound '★

End Function

3 hits

▼

【64194】Excel2007でFileSearchエラー aki 10/1/24(日) 20:39