三九宝宝网宝宝百科宝宝知识

vbs搜索文件名或者得到目录列表

12月08日 编辑 39baobao.com

[用Excel和DOS命令批量修改文件名]在你的Windows电脑上批量修改文件名是非常简单的。选择所有的文件,按F2,然后输入一下描述性的文本。Windows将会在每个文件名中加上一个的序列数字。这是一个相当快捷的解决...+阅读

'把网上的一个小程序改得方便了点,这个搜索次效率很好。

on error resume next

Dim keyWord, DirTotal, TimeSpend, FileTotal, Fso, outFile, txtResult, txtPath, sPath

Const MY_PUTER = &H11&

Const WINDOW_HANDLE = 0

Const OPTIONS = 0

Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.Namespace(My_puter)

Set objFolderItem = objFolder.Self

strPath = objFolderItem.Path

Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "选择你要搜索的文件夹:", OPTIONS, strPath)

If objFolder Is Nothing Then

msgbox "您没有选择任何有效目录!"

w.quit

else

Set objFolderItem = objFolder.Self

sPath = objFolderItem.Path

txtpath=sPath

Set Fso = w.CreateObject("ing.filesystemobject")

FileTotal = 0

DirTotal = 0

'sPath = left(W.ScriptFullName,len(W.ScriptFullName)-len(W.ScriptName))

'txtPath = trim(inputbox("你选的目录是"&sPath,"文件搜索",sPath))

keyWord = LCase(inputbox("请输入搜索关键字点Cancel的话会得到目录列表:","文件搜索","mp3"))

set outFile = Fso.createtextfile(sPath & "\SearchResult.txt")

outFile.writeline "开始搜索..."

outFile.writeline "起启目录:" & txtPath

TimeSpend = Timer

myFind txtPath

TimeSpend = round(Timer - TimeSpend,2)

txtResult = "搜索完成!" & vbCrLf & "共找到文件:" & FileTotal & "个." & vbCrLf & "共搜索目录:" & DirTotal & "个." & vbCrLf & "用时:" & TimeSpend & "秒."

outFile.write txtResult

msgbox txtResult &"结果保存在"&sPath &"\SearchResult.txt"

outFile.close

set outFile = nothing

set Fso = nothing

Sub myFind(ByVal thePath)

Dim fso, myFolder, myFile, curFolder

Set fso = w.CreateObject("ing.filesystemobject")

Set curFolders = fso.getfolder(thePath)

DirTotal = DirTotal + 1

If curFolders.Files.Count >0 Then

For Each myFile In curFolders.Files

If InStr(1, LCase(myFile.Name), keyWord) >0 Then

outFile.WriteLine FormatPath(thePath) & "\" & myFile.Name

FileTotal = FileTotal + 1

End If

Next

End If

If curFolders.subfolders.Count >0 Then

For Each myFolder In curFolders.subfolders

myFind FormatPath(thePath) & "\" & myFolder.Name

Next

End If

End Sub

Function FormatPath(ByVal thePath)

thePath = Trim(thePath)

FormatPath = thePath

If Right(thePath, 1) = "\" Then FormatPath = Mid(thePath, 1, Len(thePath) - 1)

End Function

End if

=======================================================================

附件:关于打开目录的方面:

Private Const CSIDL_DESKTOP = &H0 '

Private Const CSIDL_INTER = &H1 ' Inter Explorer (icon on desktop)

Private Const CSIDL_PROGRAMS = &H2 ' Start Menu\Programs

Private Const CSIDL_CONTROLS = &H3 ' My puter\Control Panel

Private Const CSIDL_PRINTERS = &H4 ' My puter\Printers

Private Const CSIDL_PERSONAL = &H5 ' My Documents

Private Const CSIDL_FAVORITES = &H6 ' \Forites

Private Const CSIDL_STARTUP = &H7 ' Start Menu\Programs\Startup

Private Const CSIDL_RECENT = &H8 ' \Recent

Private Const CSIDL_SENDTO = &H9 ' \SendTo

Private Const CSIDL_BITBUCKET = &HA ' \Recycle Bin

Private Const CSIDL_STARTMENU = &HB ' \Start Menu

Private Const CSIDL_MYDOCUMENTS = &HC ' logical "My Documents" desktop icon

Private Const CSIDL_MYMUSIC = &HD ' "My Music" folder

Private Const CSIDL_MYVIDEO = &HE ' "My Videos" folder

Private Const CSIDL_DESKTOPDIRECTORY = &H10 ' \Desktop

Private Const CSIDL_DRIVES = &H11 ' My puter

Private Const CSIDL_WORK = &H12 ' work Neighborhood (My work Places)

Private Const CSIDL_HOOD = &H13 ' \hood

Private Const CSIDL_FONTS = &H14 ' windows\fonts

Private Const CSIDL_TEMPLATES = &H15

Private Const CSIDL_MON_STARTMENU = &H16 ' All Users\Start Menu

Private Const CSIDL_MON_PROGRAMS = &H17 ' All Users\Start Menu\Programs

Private Const CSIDL_MON_STARTUP = &H18 ' All Users\Startup

Private Const CSIDL_MON_DESKTOPDIRECTORY = &H19 ' All Users\Desktop

Private Const CSIDL_APPDATA = &H1A ' \Application Data

Private Const CSIDL_PRINTHOOD = &H1B ' \PrintHood

Private Const CSIDL_LOCAL_APPDATA = &H1C ' \Local Settings\Applicaiton Data (non roaming)

Private Const CSIDL_ALTSTARTUP = &H1D ' non localized startup

Private Const CSIDL_MON_ALTSTARTUP = &H1E ' non localized mon startup

Private Const CSIDL_MON_FAVORITES = &H1F

Private Const CSIDL_INTER_CACHE = &H20 'TEMPORARY INTER FILES

Private Const CSIDL_COOKIES = &H21

Private Const CSIDL_HISTORY = &H22

Private Const CSIDL_MON_APPDATA = &H23 ' All Users\Application Data

Private Const CSIDL_WINDOWS = &H24 ' GetWindowsDirectory()

Private Const CSIDL_SYSTEM = &H25 ' GetSystemDirectory()

Private Const CSIDL_PROGRAM_FILES = &H26 ' C:\Program Files

Private Const CSIDL_MYPICTURES = &H27 ' C:\Program Files\My Pictures

Private Const CSIDL_PROFILE = &H28 ' USERPROFILE

Private Const CSIDL_SYSTEMX86 = &H29 ' x86 system directory on RISC

Private Const CSIDL_PROGRAM_FILESX86 = &H2A ' x86 C:\Program Files on RISC

Private Const CSIDL_PROGRAM_FILES_MON = &H2B ' C:\Program Files\mon

Private Const CSIDL_PROGRAM_FILES_MONX86 = &H2C ' x86 Program Files\mon on RISC

Private Const CSIDL_MON_TEMPLATES = &H2D ' All Users\Templates_

Private Const CSIDL_MON_DOCUMENTS = &H2E ' All Users\Documents

Private Const CSIDL_MON_ADMINTOOLS = &H2F ' All Users\Start Menu\Programs\Administrative Tools

Private Const CSIDL_ADMINTOOLS = &H30 ' \Start Menu\Programs\Administrative Tools

Private Const CSIDL_CONNECTIONS = &H31 ' work and Dial-up Connections

Private Const CSIDL_MON_MUSIC = &H35 ' All Users\My Music

Private Const CSIDL_MON_PICTURES = &H36 ' All Users\My Pictures

Private Const CSIDL_MON_VIDEO = &H37 ' All Users\My Video

Private Const CSIDL_RESOURCES = &H38 ' Resource Direcotry

Private Const CSIDL_RESOURCES_LOCALIZED = &H39 ' Localized Resource Direcotry

Private Const CSIDL_MON_OEM_LINKS = &H3A ' Links to All Users OEM specific apps

Private Const CSIDL_CDBURN_AREA = &H3B ' USERPROFILE\Local Settings\Application Data\Microsoft\CD Burning

Private Const CSIDL_PUTERSNEARME = &H3D ' puters Near Me (putered from Workgroup membership)

Private Const CSIDL_FLAG_CREATE = &H8000 ' bine with CSIDL_ value to force folder creation in SHGetFolderPath()

Private Const CSIDL_FLAG_DONT_VERIFY = &H4000 ' bine with CSIDL_ value to return an unverified folder path

Private Const CSIDL_FLAG_NO_ALIAS = &H1000 ' bine with CSIDL_ value to insure non-alias versions of the pidl

Private Const CSIDL_FLAG_PER_USER_INIT = &H800 ' bine with CSIDL_ value to indicate per-user init (eg. upgrade)

Private Const CSIDL_FLAG_MASK = &HFF00 ' mask for all possible flag values

=============================================================================

以下为关联文档:

给同事送礼或者自己收礼英语对话篇给同事送礼或者自己收礼英语对话篇 1、按英美的习俗,送礼不但可以表示感激之情,也常用来作为联络感情的一种方法。无论是父子、夫妻、朋友、情侣,彼此都可以借互赠礼物来增进感...

推荐阅读
图文推荐