Question

VB怎么获取路径里的图片名

比如，我在C盘的一个文件夹里放有许多图片，VB能把这C盘的所有图片都列出来吗？求源码谢谢！
我意思是，检查出来后把图片名字全放进一个文本框显示呢···
请问那个“Microsoft Scripting Runtime“在我的VB部件找不到怎么办？

Answer 1

以下代码放在bas模块中：

Public Declare Function FindFirstFile Lib "kernel32 " Alias "FindFirstFileA " (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32 " Alias "FindNextFileA " (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32 " (ByVal hFindFile As Long) As Long

'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Public Function fDelInvaildChr(str As String) As String
On Error Resume Next
Dim i As Long
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) <> 0 And Asc(Mid(str, i, 1)) <> 32 Then
fDelInvaildChr = Left(str, i)
Exit For
End If
Next
End Function

'遍历主函数
'参数说明:
' strPathName 要遍历的目录
' objList 使用VB的内部控件ListBox来存放遍历得到的路径
' strExt是扩展名
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Public Sub sDirTraversal(ByVal strPathName As String, ByRef objList As ListBox, ByVal strExt As String)
Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整
Dim iIndex As Integer '子目录数组下标
Dim i As Integer '用于循环子目录的查找

Dim lHandle As Long 'FindFirstFileA 的句柄
Dim tFindData As WIN32_FIND_DATA '
Dim strFileName As String '文件名

On Error Resume Next
'初始化变量
i = 1
iIndex = 0
tFindData.cFileName = " " '初始化定长字符串

lHandle = FindFirstFile(strPathName & "\*. " & strExt, tFindData)
If lHandle = 0 Then '查询结束或发生错误
Exit Sub
End If
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then '目录
If strFileName <> ". " And strFileName <> ".. " Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & "\ " & strFileName '添加到目录数组
End If
Else
objList.AddItem strPathName & "\ " & strFileName
End If
'循环查找下一个文件，直到结束
Do While True
tFindData.cFileName = " "
If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
FindClose (lHandle)
Exit Do
Else
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then
If strFileName <> ". " And strFileName <> ".. " Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & "\ " & strFileName '添加到目录数组
End If
Else
objList.AddItem strPathName & "\ " & strFileName
End If
End If
Loop
'如果该目录下有目录，则根据目录数组递归遍历
If iIndex > 0 Then
For i = 1 To iIndex
sDirTraversal sSubDir(i), objList, strExt
Next
End If
End Sub

以下代码放在窗体中，需要一个list1和一个command1:

Private Sub Command1_Click()
Call sDirTraversal( "c:\windows ", List1, "bmp ")
End Sub

===================
这个算很简单吧，1，新建个类模块，放入代码。2.在窗体嵌入代码。
这个算法是比较快的。
顺便说一下。Microsoft Scripting Runtime 不是部件，是在菜单里面 工程 - 引用部件 里面选的。 采纳我吧，解决你2个疑问。嘻嘻。

Answer 2

原理是：把整个路径当作一个字符串，然后从右往左检索，当查到第一个反斜杠时，它右边的全部内容就是一个文件名。
如：设一个图片的完整路径是path1="d:\photo\mine\work001.jpg"
从右往左检索到第一个“\”出现的位置（位于e与w之间，即第14个字符的位置），那么从第15个字符后面的字符即是图片名。

Answer 3

用File控件，把类型改为JPG.GIF等,Path设为目标文件夹
就可以得到图片列表

Answer 4

'工程引用：Microsoft Scripting Runtime
Sub rename()
Dim fso As FileSystemObject
Dim fd As Folder
Dim f As File
Dim fn As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set fd = fso.GetFolder("C:/图片") '图片文件夹路径
For Each f In fd.Files
fn = f.Name '图片名称
Print fn
Next
Set fso = Nothing
Set fd = Nothing
Set f = Nothing
End Sub