51Testing软件测试论坛

 找回密码
 (注-册)加入51Testing

QQ登录

只需一步,快速开始

微信登录,快人一步

手机号码,快捷登录

查看: 3039|回复: 17
打印 上一主题 下一主题

[原创] 编写一个VBS的程序

[复制链接]

该用户从未签到

跳转到指定楼层
1#
发表于 2010-5-5 16:53:28 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
VBS编写如下:访问两个存放在不同位置的文件夹,查看里面是不是有相同的文件,然后输出这些相同的文件!

[ 本帖最后由 ELLKKLLE 于 2010-5-13 16:38 编辑 ]
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏
回复

使用道具 举报

该用户从未签到

2#
发表于 2010-5-5 17:14:53 | 只看该作者
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等等]。

当中有一些关键语句可以借鉴.然后做些修改即可
回复 支持 反对

使用道具 举报

该用户从未签到

3#
 楼主| 发表于 2010-5-5 17:21:27 | 只看该作者
非常感谢,我先试试!
回复 支持 反对

使用道具 举报

该用户从未签到

4#
发表于 2010-5-5 17:26:06 | 只看该作者
相同是什么意思?是名字相同?还是文件内容相同?
回复 支持 反对

使用道具 举报

该用户从未签到

5#
发表于 2010-5-5 17:30:59 | 只看该作者

回复 2# 的帖子

看来楼主是要做自动化测试了,应该是用QTP的吧?呵呵
回复 支持 反对

使用道具 举报

该用户从未签到

6#
 楼主| 发表于 2010-5-5 17:51:22 | 只看该作者

回复 4# 的帖子

初步是文件名吧,等这个实现后,就要比较版本、发布日期、大小等等了
回复 支持 反对

使用道具 举报

该用户从未签到

7#
 楼主| 发表于 2010-5-5 17:53:00 | 只看该作者

回复 5# 的帖子

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

使用道具 举报

该用户从未签到

8#
 楼主| 发表于 2010-5-5 17:54:23 | 只看该作者
愁着呢
回复 支持 反对

使用道具 举报

该用户从未签到

9#
发表于 2010-5-5 18:02:57 | 只看该作者
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 编辑 ]
回复 支持 反对

使用道具 举报

该用户从未签到

10#
 楼主| 发表于 2010-5-5 18:06:52 | 只看该作者

回复 8# 的帖子

运行有错误,5555。
十分谢谢,感激涕零了
回复 支持 反对

使用道具 举报

  • TA的每日心情
    奋斗
    2014-12-18 10:31
  • 签到天数: 1 天

    连续签到: 1 天

    [LV.1]测试小兵

    11#
    发表于 2010-5-5 18:19:37 | 只看该作者

    自己写着玩的(不包含子文件夹的比较)

    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 编辑 ]
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    12#
     楼主| 发表于 2010-5-5 21:14:41 | 只看该作者

    回复 11# 的帖子

    谢谢了 太感谢了
    看来我得加吧劲了喔
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    13#
     楼主| 发表于 2010-5-6 09:31:22 | 只看该作者

    回复 11# 的帖子

    谢谢11楼的大侠,你的脚本真的好用!
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    14#
     楼主| 发表于 2010-5-6 09:54:46 | 只看该作者

    谢谢大家支持

    首先,谢谢大家支持

    [ 本帖最后由 ELLKKLLE 于 2010-5-6 11:02 编辑 ]
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    15#
    发表于 2010-5-6 12:53:30 | 只看该作者
    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

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

    使用道具 举报

    该用户从未签到

    16#
     楼主| 发表于 2010-5-6 14:04:03 | 只看该作者

    回复 15# 的帖子

    谢谢您老,感激不尽
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    17#
    发表于 2010-5-6 14:15:02 | 只看该作者
    ....我虽然老了,但是也不是很老啊,25而已~~
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    18#
     楼主| 发表于 2010-5-6 14:24:24 | 只看该作者

    回复 17# 的帖子

    你是VB的前辈呀 哈哈 不是那个年龄上的老
    回复 支持 反对

    使用道具 举报

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    小黑屋|手机版|Archiver|51Testing软件测试网 ( 沪ICP备05003035号 关于我们

    GMT+8, 2024-11-9 05:48 , Processed in 0.075344 second(s), 27 queries .

    Powered by Discuz! X3.2

    © 2001-2024 Comsenz Inc.

    快速回复 返回顶部 返回列表