Excel VBA質問箱 IV

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

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


17822 / 76732 ←次へ | 前へ→

【64358】Re:Excel2007でFileSearchエラー
発言  かみちゃん E-MAIL  - 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

1 hits

【64194】Excel2007でFileSearchエラー aki 10/1/24(日) 20:39 質問
【64195】Re:Excel2007でFileSearchエラー かみちゃん 10/1/24(日) 20:49 発言
【64340】Re:Excel2007でFileSearchエラー aki 10/1/31(日) 9:13 お礼
【64358】Re:Excel2007でFileSearchエラー かみちゃん 10/1/31(日) 14:13 発言
【64373】Re:Excel2007でFileSearchエラー aki 10/1/31(日) 21:21 お礼

17822 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free