编写一个VBS的程序

ELLKKLLE

VBS编写如下：访问两个存放在不同位置的文件夹，查看里面是不是有相同的文件，然后输出这些相同的文件！

[ 本帖最后由 ELLKKLLE 于 2010-5-13 16:38 编辑 ]

ecust

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

将以上代码搜索自网络, 编译成exe文件与“图像”文件夹放在同一目录中即可，作用是运行后即可在“图像”文件夹中遍历所有下一级子文件夹及所有文件，凡是文件扩展名符合“jpg/jpeg”或“tif/tiff”的都被写入当前目录中的“mytxt.txt”文件中。当然，你还可以扩充更多的图片文件类型[比如bmp、gif等等]。

当中有一些关键语句可以借鉴.然后做些修改即可

ELLKKLLE

非常感谢，我先试试！

风雪夜归人

相同是什么意思?是名字相同?还是文件内容相同?

swlcom

看来楼主是要做自动化测试了，应该是用QTP的吧？呵呵

ELLKKLLE

初步是文件名吧，等这个实现后，就要比较版本、发布日期、大小等等了

ELLKKLLE

不是呀 客户给了个脚本 头头说太复杂了 让重新我写一个
其实我都没学过VBS，前几天用PS写了，觉得用起来不是那么简单，就该VBS了

ELLKKLLE

愁着呢

风雪夜归人

strFolderPath1 = "C:\test1"
strFolderPath2 = "C:\test3"
strSameFiles = ""

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

运行有错误，5555。
十分谢谢，感激涕零了

feiyunkai

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

[ 本帖最后由 feiyunkai 于 2010-5-5 18:31 编辑 ]

ELLKKLLE

谢谢了 太感谢了
看来我得加吧劲了喔

ELLKKLLE

谢谢11楼的大侠，你的脚本真的好用！

ELLKKLLE

首先，谢谢大家支持

[ 本帖最后由 ELLKKLLE 于 2010-5-6 11:02 编辑 ]

风雪夜归人

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

昨天时间有点紧,没有写比较子文件夹的,这个基本比较功能实现了,比较文件名字相同的.

ELLKKLLE

谢谢您老，感激不尽

风雪夜归人

....我虽然老了,但是也不是很老啊,25而已~~

ELLKKLLE

你是VB的前辈呀 哈哈 不是那个年龄上的老