broly

Dim strPath,fso,fc,f,strAns
strPath="D:\mail" '此处为文件夹名字
Set fso=CreateObject("Scripting.FileSystemObject")
Set fc=fso.GetFolder(strPath).SubFolders
For Each f In fc
  Call SetClipboardText(f.Name)
  strAns=MsgBox(f.Name&"已复制，下一个？",vbYesNo+vbInformation,"提示")
  If strAns<>vbYes Then WScript.Quit
Next
Sub SetClipboardText(Text)   '写入信息到剪切板
    Dim wsh
    Set wsh = CreateObject("WScript.Shell")
    wsh.Run "mshta vbscript:ClipboardData.SetData("&chr(34)&"text"&chr(34)&"," &Chr(34)& Text &Chr(34)& ")(close)",0,True
    set wsh=Nothing
End Sub
复制代码