本帖最后由 czjt1234 于 2023-11-16 21:29 编辑
- Option Explicit
- Dim oFSO, oShell, oRegExp, oDrive, s, i
-
- Const p1 = "zy\11" 'U盘中的文件夹,前后都不要有\
-
- WScript.Timeout = 3000 '指定多少秒后自动结束vbs
-
- Set oFSO = CreateObject("Scripting.FileSystemObject")
- Set oShell = CreateObject("Shell.Application")
- Set oRegExp = CreateObject("VBScript.RegExp")
- oRegExp.IgnoreCase = True
- oRegExp.Pattern = "^file:///([c-z]:/.*)"
-
- Do
- For i = 67 To 90
- s = Chr(i) & ":"
- If oFSO.DriveExists(s) Then
- Set oDrive = oFSO.GetDrive(s)
- If oDrive.DriveType = 1 And oDrive.IsReady Then
- Call copyPic(oDrive.Path)
- End If
- End If
- Next
- WScript.Sleep 1000
- Loop
-
- Sub copyPic(ByVal p)
- Dim j, s, oFolder, oFolderItems, oFolderItem
- p = p & "\"
- For Each j In oShell.Windows()
- If oRegExp.Test(j.LocationURL) Then
- s = oRegExp.Execute(j.LocationURL)(0).SubMatches(0)
- End If
- Next
- s = RePlace(s, "/", "\")
- Set oFolder = oShell.NameSpace(s)
- Set oFolderItems = oFolder.Items()
- oFolderItems.Filter &H40 + &H80 + &H10000, "*.jpg;*.jpeg;*.bmp;*.png"
- Set oFolder = oShell.NameSpace(p)
- p = p & p1 & "\"
- s = """" & p & """"
- For Each oFolderItem In oFolderItems
- If Not oFSO.FileExists(p & oFolderItem.Name) Then
- oShell.ShellExecute "cmd.exe", "/c copy """ & oFolderItem.Path & """ " & s,,, 0
- End If
- Next
- End Sub
复制代码
|