[已解决]如何打开指定的目录,把所有图片的文件名提取放到listbox控件中去?

yiyaozjk · 发表于 2011-8-24 21:12

做这个例子时,我不知道该怎么写才正确?? 下面是我的代码
Private Sub Command1_Click()
Dim arr
Dim StrText As String
'On Error GoTo Note '当出现错误时，跳转到Note语句
With CommonDialog1
.DialogTitle = "打开对话框"
.Filter = "图片文档(*.jpg) |*.jpg|图片文档(*.bmp) |*.bmp"
.FilterIndex = 1
Text1.Text = ""
.ShowOpen       '或使用CommonDialog1.Action=1
Text1.Text = .FileName
End With
If Err.Number > 1 Then '如果打开文件正确
MsgBox "你打开的文件不正确！"
Exit Sub
End If
n = 0
arr(0)="" '这里需不需要这里先赋值?否则没有文件呢?那List1.List = arr赋值就会出错吧?'
StrText = Dir(CommonDialog1.InitDir &"\*.jpg") (好象这个DIR()没有找到文件似的．strtext监视为空，但总不至每个被打开的文件夹内没有图片文件吧？有点离谱)
   While Len(StrText) > 0
   n = n + 1
ReDim Preserve arr(1 To n)
   arr(n) = Split(LCase(StrText), ".jpg")(0)
   StrText = Dir  'DIR ()
Wend
List1.List = arr    报错说此句参数不对???
End Sub

要么高手给一个正确答案来参考一下...希望能实现自动将目录下所有文件名提取出来....

最佳答案

月排行榜 / 总排行榜

liuguansky

2011-8-25 15:56

Private Sub ListBox1_Click()
Image1.Picture = LoadPicture(ThisWorkbook.Path & "" & ListBox1.List(ListBox1.ListIndex))
End Sub
Private Sub UserForm_Initialize()
Dim pType, pat$, I$, j%
ListBox1.Clear
pType = Array("\*.jpg", "\*.gif")
pat = ThisWorkbook.Path
For j = LBound(pType) To UBound(pType)
I = Dir(pat & pType(j))
Do While I <> ""
ListBox1.AddItem Split(I, "")(UBound(Split(I, "")))
I = Dir()
Loop
Next j
ListBox1.Height = ListBox1.Font.Weight * ListBox1.ListCount + 4
End Sub

复制代码

桌面.rar (28.13 KB, 下载次数: 90)

那么的帅 · 发表于 2011-8-24 21:50

回复 yiyaozjk 的帖子

提供数据附件

yiyaozjk · 发表于 2011-8-25 09:06

如何打开指定的目录,把所有图片的文件名提取放到listbox控件中去,

我觉得没有必要提供数据吧? 只要你在自己的电脑上打开一个有图片的目录就可以测试到呀??

那么的帅 · 发表于 2011-8-25 13:26

回复 yiyaozjk 的帖子

需要别人帮助解决问题，还要人家自己准备材料？

liuguansky · 发表于 2011-8-25 15:56

这个最佳答案由 liuguansky 给出，感谢 liuguansky 的回答。

单击隐藏图章

Private Sub ListBox1_Click()
Image1.Picture = LoadPicture(ThisWorkbook.Path & "" & ListBox1.List(ListBox1.ListIndex))
End Sub
Private Sub UserForm_Initialize()
Dim pType, pat$, I$, j%
ListBox1.Clear
pType = Array("\*.jpg", "\*.gif")
pat = ThisWorkbook.Path
For j = LBound(pType) To UBound(pType)
I = Dir(pat & pType(j))
Do While I <> ""
ListBox1.AddItem Split(I, "")(UBound(Split(I, "")))
I = Dir()
Loop
Next j
ListBox1.Height = ListBox1.Font.Weight * ListBox1.ListCount + 4
End Sub

复制代码

桌面.rar (28.13 KB, 下载次数: 90)

yiyaozjk · 发表于 2011-8-25 20:58

回复 liuguansky 的帖子

能否也分享一下你如何继续查找该文件夹内包含的子文件夹怎么继续处理呢???

下面是我从网搜索下来,自己修改了一下的..,经过测试是OK的,但是有一点没有通过,想将指定的目录修改成打开对话框CommonDialog1的目录,没有成功,不为何???

Private Sub Command3_Click()             '这是 "提取整个文件夹的文件名" 按钮的代码
'引用FSO( "工程 "-> "引用 "-> Microsoft Scripting Runtime)
      SearchFolder "e:\gongshitu"       '想改成一个 CommonDialog1.initdir 测试了不能通过不知为何(当前前面加了一个CommonDialog控件)
'List1.Style = CheckBox VB中是不能在程序设置此属性的
   MsgBox "所有的子文件夹搜索完毕"    '此句如果放在下面的过程中会出现了2次以上的搜索完毕提示'
End Sub
Sub SearchFolder(ByVal Folder As String)
      Dim Fso    As New FileSystemObject
      Dim objFile, objFolder
      Dim n As Integer
      Dim arr()
      Set objFolder = Fso.GetFolder(Folder) 更改成了CommonDialog1.initdir 后,在这句报无效的路径不知为何>???
      For Each objFile In objFolder.Files
      'if  objFile.Path
            WriteFile objFile.Path
         n = n + 1
         ReDim Preserve arr(1 To n)
            If InStr(objFile.Path, ".jpg") > 0 Then
            arr(n) = objFile.Path
            If Mid(objFile.Path, InStrRev(objFile.Path, ".")) <> ".jpg" Then
               MsgBox "里面包含非图片型文件,要注意"
            Else
            ' instrrev(objfile.,".")
            List1.AddItem objFile.Path    '将文件名写到List1控件中去
            End If

               'n = InStr(1, Str, "\")    这些代码是用来从右边截取字符的代码,以便以后使用.
               'While n
               'Str = Right(Str, Len(Str) - n)
               'n = InStr(1, Str, "\")
               'Wend
         End If
      Next
         '如果存在子文件夹的时候继续写'
      For Each objFolder In objFolder.SubFolders
            WriteFile objFolder.Path
         If InStr(objFolder.Path, ".jpg") > 0 Then                                  '查看是否包含了.jpg格式的文件
            n = n + 1
            ReDim Preserve arr(1 To n)
            arr(n) = objFolder.Path
            If Mid(objFolder.Path, InStrRev(objFolder.Path, ".")) <> ".jpg" Then    '用了这层才能确保后缀名为.jpg格式'
               MsgBox "里面包含非图片型文件,要注意"
            Else
               'instrrev(objfile.,".")
               List1.AddItem objFolder.Path                                        '将文件名写到List1控件中去
            End If
         End If
            SearchFolder objFolder                                                 '递归遍历整颗树
      Next
End Sub

joyark · 发表于 2011-8-25 22:10

需要别人帮助解决问题，还要人家自己准备材料？

Select · 发表于 2011-8-25 23:12

同意4楼，7楼

fjmxwrs · 发表于 2011-8-25 23:17

楼主不是有现成的文件吗？上传一个就这么难吗？你的文件设置与别人的不同，代码自然也不同。

		自动登录	找回密码
密码			注册