[ 本帖最后由 ELLKKLLE 于 2010-5-13 16:38 编辑 ]作者: ecust 时间: 2010-5-5 17:14
Private Sub Form_Load()
Dim fs, fd, fc, fcc, f, ff, myext
Set fs = CreateObject("Scripting.FileSystemObject")
Set fd = fs.GetFolder(App.Path & "/图像")
Set fc = fd.subFolders
Open App.Path & "/mytxt.txt" For Output As #1
For Each f In fc
Set fcc = f.Files
For Each ff In fcc
myext = fs.GetExtensionName(ff.Name)
If LCase(myext) = "jpg" Or LCase(myext) = "jpeg" Or LCase(myext) = "tif" Or LCase(myext) = "tiff" Then
Print #1, ff.Name & " ",
End If
Next
Next
Close
End
End Sub
Set FSO = CreateObject("scripting.FileSystemObject")
If FSO.FolderExists(strFolderPath1) Then
Set FS1 = FSO.GetFolder(strFolderPath1)
Else
MsgBox "Folder " & strFolderPath1 & "does not exist!"
strFolderPath1 = InputBox("Input first folder you wanna search", "Input the folder path")
Set FS1 = FSO.GetFolder(strFolderPath1)
End If
If FSO.FolderExists(strFolderPath2) Then
Set FS2 = FSO.GetFolder(strFolderPath2)
Else
MsgBox "Folder " & strFolderPath1 & "does not exist!"
strFolderPath1 = InputBox("Input second folder you wanna search", "Input the folder path")
Set FS1 = FSO.GetFolder(strFolderPath2)
End If
strResult = SearchSameFile(FS1, FS2)
If strResult <> "" Then
For Each strFileName In Split(strResult, "|")
If strFileName <> "" Then
MsgBox strFileName
End If
Next
Else
MsgBox "There is no same file in folder: " & strFolderPath1 & " and folder: " & strFolderPath2
End If
Function SearchSameFile(objFolder1, objFolder2)
For Each file1 In objFolder1.Files
strFileName1 = file1.Name
For Each file2 In objFolder2.Files
If strFileName1 = file2.Name Then
strSameFiles = strFileName1 & "|" & strSameFiles
Exit For
End If
Next
Next
SearchSameFile = strSameFiles
End Function
Set FS1 = Nothing
Set FS2 = Nothing
Set FSO = Nothing
查找相同名字的
..function忘记了...
[ 本帖最后由 风雪夜归人 于 2010-5-6 11:00 编辑 ]作者: ELLKKLLE 时间: 2010-5-5 18:06 标题: 回复 8# 的帖子 运行有错误，5555。
十分谢谢，感激涕零了作者: feiyunkai 时间: 2010-5-5 18:19 标题: 自己写着玩的（不包含子文件夹的比较） path1="D:\\folder1" '第一个文件夹的路径
path2="D:\\folder2"'第二个文件夹的路径
samefile=""
Set obj=CreateObject("scripting.filesystemobject")
If obj.FolderExists(Path1) and obj.FolderExists(Path2) then
Set objfol1=obj.GetFolder(path1)
Set objfol2=obj.GetFolder(path2)
For Each file1 In objfol1.Files
For Each file2 In objfol2.Files
If file1.name=file2.name Then
samefile=samefile&" "&file1.name
End If
Next
Next
msgbox "相同的文件名称为："&samefile
else
msgbox "请检查所比较的文件夹是否存在"
End If
Set objfol1=Nothing
Set objfol2=Nothing
Set obj=Nothing
[ 本帖最后由 ELLKKLLE 于 2010-5-6 11:02 编辑 ]作者: 风雪夜归人 时间: 2010-5-6 12:53
strFolderPath1 = "C:\test1" 'The first folder you want search from
strFolderPath2 = "C:\test2" 'The second folder you want search from
strSameFiles = ""
Set FSO = CreateObject("scripting.FileSystemObject")
'If the first folder doesnot exists, input the folder path
If FSO.FolderExists(strFolderPath1) Then
Set FS1 = FSO.GetFolder(strFolderPath1)
Else
MsgBox "Folder " & strFolderPath1 & " does not exist!"
strFolderPath1 = InputBox("Input first folder you wanna search", "Input the folder path")
Set FS1 = FSO.GetFolder(strFolderPath1)
End If
'If the second folder doesnot exists, input the folder path
If FSO.FolderExists(strFolderPath2) Then
Set FS2 = FSO.GetFolder(strFolderPath2)
Else
MsgBox "Folder " & strFolderPath2 & " does not exist!"
strFolderPath2 = InputBox("Input second folder you wanna search", "Input the folder path")
Set FS2 = FSO.GetFolder(strFolderPath2)
End If
SearchSame FS1, FS2
Function SearchSame(objFolder1, objFolder2)
If objFolder1.SubFolders.Count <> 0 Then
For Each subFolder1 In objFolder1.SubFolders
strFolderName1 = subFolder1.Name
For Each subFolder2 In objFolder2.SubFolders
If strFolderName1 = subFolder2.Name Then
SearchSame subFolder1, subFolder2
End If
Next
Next
End If
SearchSameFile objFolder1, objFolder2
End Function
Function OutputTheResult(strFolderPath1, strFolderPath2, strResult)
If strResult <> "" Then
MsgBox "There is same files in folder: " & strFolderPath1 & " and folder: " & strFolderPath2
For Each strFileName In Split(strResult, "|")
If strFileName <> "" Then
MsgBox strFileName
End If
Next
Else
MsgBox "There is no same file in folder: " & strFolderPath1 & " and folder: " & strFolderPath2
End If
End Function
Function SearchSameFile (objFolder1, objFolder2)
strSameFiles = ""
For Each file1 In objFolder1.Files
strFileName1 = file1.Name
For Each file2 In objFolder2.Files
If strFileName1 = file2.Name Then
strSameFiles = strFileName1 & "|" & strSameFiles
Exit For
End If
Next
Next
OutputTheResult objFolder1.Path, objFolder2.Path, strSameFiles
End Function
Set FS1 = Nothing
Set FS2 = Nothing
Set FSO = Nothing
