如何用VBS来检测指定文件夹下有否有新文件产生

'══代══码══开══始════

set fso=CreateObject("Scripting.FileSystemObject")

set ws=CreateObject("wscript.shell")

Set d = CreateObject("手汪Scripting.Dictionary")

dir="C:\123"

'这里C:\123，代表要监视的毕蠢仔文件夹，自己修改

do

set fs=fso.getfolder(dir).files

for each f in fs

if not d.Exists(f.name) then

ws.popup "发现新文件"&vblf&f.name,10

d.add f.name,f.name

end if

next

wscript.sleep 1000

loop

'Coded By escortmnm from VBS团队

'══档薯代══码══结══束════

Dim ExtStr,SourseFolder,CopyFolder,FSO,F

ExtStr="mp3" ' 后缀名

SourseFolder="D:\123" ' 监视的文件夹

CopyFolder="D:\123\1" ' 复制后的文件夹

Dim SourseFilePathArr(),SourseFileSizeArr(),IsSourseFilePathArr

Dim CopyFilePathArr(),CopyFileSizeArr(),IsCopyFilePathArr

Dim IsTrue

Set FSO = CreateObject("Scripting.FileSystemObject")

Do

   IsSourseFilePathArr=True

   IsCopyFilePathArr=True

   

   ' 读取监视文件夹的文件

   Set fo=fso.GetFolder(SourseFolder)

   Set fs=fo.Files

   For Each F In fs

      If LCase(FSO.GetExtensionName(F.Name))=LCase(ExtStr) Then

         If IsSourseFilePathArr=True Then

            IsSourseFilePathArr=False

            ReDim SourseFilePathArr(0)

            ReDim SourseFileSizeArr(0)

         Else

            ReDim Preserve SourseFilePathArr(UBound(SourseFilePathArr)+1)

            ReDim Preserve SourseFileSizeArr(UBound(SourseFileSizeArr)+1)

         End If

         SourseFilePathArr(UBound(SourseFilePathArr))=F.Path

         SourseFileSizeArr(UBound(SourseFileSizeArr))=F.Size

      End If

   Next

   

   ' 读取复制后文件夹的文件

   Set fo=fso.GetFolder(CopyFolder)

   Set fs=fo.Files

   For Each F In fs

      If LCase(FSO.GetExtensionName(F.Name))=LCase(ExtStr) Then

         If IsCopyFilePathArr=True Then

            IsCopyFilePathArr=False

            ReDim CopyFilePathArr(0)

            ReDim CopyFileSizeArr(0)

        茄弊 Else

            ReDim Preserve CopyFilePathArr(UBound(CopyFilePathArr)+1)

            ReDim Preserve CopyFileSizeArr(UBound(CopyFileSizeArr)+1)

         End If

         CopyFilePathArr(UBound(CopyFilePathArr))=F.Path

         CopyFileSizeArr(UBound(CopyFileSizeArr))=F.Size

      End If

   Next

   

   ' 按文件大小比对文件，相同大小的认为是相同文件

   If IsSourseFilePathArr=False Then

      For i=0 To UBound(SourseFileSizeArr)

         IsTrue=False

         If IsCopyFilePathArr=False Then

 颤隐族           For j=0 To UBound(CopyFileSizeArr)

               If CopyFileSizeArr(j)=SourseFileSizeArr(i) Then

                  IsTrue=True

                  Exit For

               End If

            Next

         End If

         If IsTrue=False Then

            j=0

            Do

               j=j+1

               If FSO.FileExists(CopyFolder & "\" & j & "." & ExtStr)=False Then

                  Exit Do

        携历       End If

            Loop

            Set F=FSO.GetFile(SourseFilePathArr(i))

            F.Copy CopyFolder & "\" & j & "." & ExtStr,True

         End If

      Next

   End If

   

   WScript.Sleep 2000

Loop

'

' 说明：

' 1、程序运行后每2秒循环一次

' 2、以文件大小的方式比对原文件夹和复制后文件夹中mp3文件，若不同，则认为是新文件

' 3、比对文件应该用MD5，但是VBS没有MD5，因此使用文件大小

' 4、从1开始寻找复制文件夹中没有的文件名作为复制后的文件名

我自创的方法。考虑到实时检测是否有新文件，应该用一个Timer。

画两个FileListBox控件，控件名分别为File1、File2；画一个TextBox，名为Text1；画一个Timer，名为Timer1。要求将目标文件夹新生成的Txt文件内容显示到Text1中。

Private Sub Form_Load()

File1.Path = "在引号里打上要监测的路径。如果路径不是某个盘的根目录则不要雀简在最后一个文件夹名的后面打上“顷散裤\”"

File2.Path = File1.Path

File1.Pattern = "*.txt"

File2.Pattern = "*.txt"

File1.Visible = False

File2.Visible = False

Timer1.Interval = 在等号后面打上一个整数用来确定扫描新文件的频率，单位是掘陪毫秒，最低值是1

End Sub

Private Sub Timer1_Timer()

File2.Refresh

If File2.ListCount >File1.ListCount Then

If File1.ListCount = 0 Then

File2.ListIndex = 0

Else

i = 0

File1.ListIndex = i

File2.ListIndex = i

Do While File2.FileName = File1.FileName And i <= File1.ListCount - 1

File1.ListIndex = i

File2.ListIndex = i

i = i + 1

Loop

If i = File1.ListCount - 1 Then

File2.ListIndex = i - 1

Else

File2.ListIndex = i

End If

End If

url = File2.Path

If Right(url, 1) <>"\" Then

url = url &"\"

End If

url = url &File2.FileName

Open url For Input As #1

Text1.Text = StrConv(InputB(LOF(1), #1), vbUnicode)

Close #1

File1.Refresh

End If

If File2.ListCount <File1.ListCount Then

File1.Refresh

End If

End Sub

绝对好使，我在VB上试过了。

---