[寄存]VBS对文件文件夹操作的例子

zengbj 2014-06-06

展开全文

返回总目录

原作者：we似曾相识
原地址：

//=====================<VBS对文件夹操作例子>
(1)创建文件夹

CODE:

Dim fso, f

'如果指定的文件夹已经存在，则会出现错误。

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.CreateFolder("c:\New Folder")

(2)删除文件夹

CODE:

Dim fso,filespec

filespec="D:\电影" '要删除的文件夹路径

Set fso = CreateObject("Scripting.FileSystemObject")

fso.DeleteFolder(filespec)

'若删除只读文件夹则将上一行改为fso.DeleteFolder(filespec,true)

(3)判断文件夹是否存在

CODE:

Dim fso,msg,tt

Set fso = CreateObject("Scripting.FileSystemObject")

fldr="C:\Documents and Settings" '文件夹路径和名字

tt = fso.FolderExists(fldr) '存在返回true;不存在返回false

If tt=true Then

msg = fldr & " 存在。"

Else

msg = fldr & " 不存在。"

End If

Msgbox msg

(4)获取指定目录下所有文件的文件名(不包含文件夹名)

CODE:

Dim a

a="D:\文件夹1"     '目标文件夹完整路径

Msgbox ShowFolderList(a)

Function ShowFolderList(folderspec)

    Dim fso, f, f1, fc, s    '定义变量

    Set fso = CreateObject("Scripting.FileSystemObject") '创建对象

    Set f = fso.GetFolder(folderspec)  '得到文件夹下folder对象

    Set fc = f.Files

    For Each f1 in fc   '查找所有符合条件的文件名

        s = s & f1.name 

        s = s & vbcrlf    '得到结果并换行

    Next

    ShowFolderList = s

End Function

(5)分离路径中的文件名(不带扩展名)

CODE:

Msgbox GetTheBase("C:\tt.txt")  'GetTheBase返回值tt

Function GetTheBase(filespec)

  Dim fso

  Set fso = CreateObject("Scripting.FileSystemObject")

  GetTheBase = fso.GetBaseName(filespec)

End Function

//=====================<VBS对文件操作例子>
(1)创建文件

CODE:

Dim fso, MyFile

Set fso = CreateObject("Scripting.FileSystemObject")

Set MyFile = fso.CreateTextFile("c:\123.txt", True) 'true则可以覆盖已有的同名文件

Msgbox "这是一个测试"

MyFile.Close  'close是必要的,不要省

(2)删除文件

CODE:

Dim fso,filespec

filespec="C:\123.txt" '要删除的文件

'设置成"C:\*.doc"则删除C目录下所有.doc扩展名的文档(但不会删除其子文件夹下.doc文档)

Set fso = CreateObject("Scripting.FileSystemObject")

fso.DeleteFile(filespec)

'若删除只读文件则将上一行改为fso.DeleteFile(filespec,true)

(3)判断文件是否存在

CODE:

Dim fso,msg,tt

Set fso = CreateObject("Scripting.FileSystemObject")

fle="C:\123.txt" '文件的完整路径

tt = fso.FileExists(fle) '存在返回true;不存在返回false

If tt=true Then

msg = fle & " 存在。"

Else

msg = fle & " 不存在。"

End If

Msgbox msg

(4)创建快捷方式的例子

CODE:

'用CreateObject的方法开启WshShell

Set WshShell=CreateObject("WScript.Shell")

'制定文件夹为桌面

strDesKtop=WshShell.SpecialFolders("DesKtop")

'在制定文件夹创建"画笔.lnk"快捷方式

Set oShellLink=WshShell.CreateShortcut(strDesKtop&"\画图.lnk")

'制定快捷方式指向的目标程序

oShellLink.TargetPath="mspaint.exe"

'制定风格

oShellLink.WindowStyle=1

'制定热键

oShellLink.Hotkey="CTRL+SHIFT+P"

'制定图标

oShellLink.IconLocation="mspaint.exe,0"

'注释快捷方式

oShellLink.Description="有标准VBS建立的画笔快捷方式"

'制定工作目录

oShellLink.WorkingDirectory=strDesKtop

'保存快捷方式

oShellLink.Save

(5)获取文件创建访问等信息

CODE:

Msgbox FileInfor("C:\b.txt")

  Function FileInfor(FilePath)

  Dim fso, f, s ,a

  Set fso = CreateObject("Scripting.FileSystemObject")

  a=FilePath  '文件完整路径

  Set f = fso.GetFile(a)

  s = f.Path & vbcrlf

  s = s & "创建时间: " & f.DateCreated & vbcrlf  

  s = s & "访问时间: " & f.DateLastModified & vbcrlf

  s = s & "修改时间: " & f.DateLastAccessed

  ShowFileAccessInfo = s

  FileInfor = s

  End Function

(6)VBS获取特定文件路径

CODE:

Set wshell = CreateObject("WScript.Shell")

PathDesktop = wshell.specialfolders("Desktop")

MsgBox PathDesktop&"=桌面 的绝对路径"

PathFavorites = wshell.specialfolders("Favorites")

MsgBox PathFavorites&"=收藏夹 的绝对路径"

PathFonts = wshell.specialfolders("Fonts")

MsgBox PathFonts&"=字体 的绝对路径"

PathMyDocuments = wshell.specialfolders("MyDocuments")

MsgBox PathMyDocuments&"=我的文档 的绝对路径"

PathNetHood = wshell.specialfolders("NetHood")

MsgBox PathNetHood&"=网上邻居 的绝对路径"

PathPrintHood = wshell.specialfolders("PrintHood")

MsgBox PathPrintHood&"=打印机 的绝对路径"

PathPrograms = wshell.specialfolders("Programs")

MsgBox PathPrograms&"=程序 的绝对路径"

PathRecent = wshell.specialfolders("Recent")

MsgBox PathRecent&"=最近文档 的绝对路径"

PathSendTo = wshell.specialfolders("SendTo")

MsgBox PathSendTo&"=发送到 的绝对路径"

PathStartMenu = wshell.specialfolders("StartMenu")

MsgBox PathStartMenu&"=开始菜单 的绝对路径"

PathStartUp = wshell.specialfolders("StartUp")

MsgBox PathStartUp&"=启动 的绝对路径"

PathTemplates = wshell.specialfolders("Templates")

MsgBox PathTemplates&"=模板 的绝对路径"

(7)复制文件到其他目录

CODE:

Dim sPath, tPath 

sPath="C:\tt.txt"

tPath="D:\tt.txt"

set fso=CreateObject("Scripting.FileSystemObject")

fso.CopyFile sPath, tPath  '将C:\tt.txt复制到D盘

(8)将某文件夹下所有指定格式文件拷贝到其他目录

CODE:

Const OverwriteExisting = True

Set objFSO = CreateObject("Scripting.FileSystemObject")

objFSO.CopyFile "C:\*.txt" , "D:\" ,OverwriteExisting

VBS读取、修改.INI文件键值
(1)VBS读取.INI文件键值

CODE:

Msgbox ReadINI("C:\123.ini","c","timeout")  '输入的小节或键名不存在则返回为空

Function ReadINI(FilePath,Bar,PrimaryKey)

Dim fso,sReadLine,i,j,ss

Set fso=CreateObject("Scripting.FileSystemObject")

Set INIfile=fso.opentextfile(FilePath,1)

do until INIfile.atendofstream 

    sReadLine=INIfile.readline

If sReadLine="" then

    INIfile.skipline

ElseIf Trim(sReadLine)="["& Bar &"]" then '找到小节名

    '查找该小节名下的键名

    Do until INIfile.atendofstream

    sReadLine=INIfile.readline  '读取小节名后的行

    j=instr(sReadLine,"=")

    If j>0 then   '小节名后的文本行存在

       If instr(Left(sReadLine,j),PrimaryKey)>0 then  '从"="左边字符串找到键名

          ss = Trim(Right(sReadLine,len(sReadLine)-instr(sReadLine,"=")))          

          Exit do

       Else

          INIfile.skipline  '没找到键名跳过此行

       End If

    Else

       INIfile.skipline

    End If

    Loop

Else

End If

loop

INIfile.close

Set fso=nothing

ReadINI = ss

End Function

(2)VBS修改.INI文件键值

CODE:

Call WriteINI("C:\123.ini","c","timeout", "abcdef")

'上面一行是调用方法

Function WriteINI(FilePath, Bar, PrimaryKey, Value)

On Error Resume Next

Const ForReading=1

Const ForWriting=2

Const ForAppending=8

Dim fso, sRead, i, j, sReadLine, BE, stxt

Set fso=CreateObject("Scripting.FileSystemObject")

Set ForRead=fso.opentextfile(FilePath,1)

Dim a()  '文本内容逐行放入数组

i=0

j=0

BE=0

sRead=ForRead.ReadAll

ForRead.close

If Instr(sRead,"[")=0 then  '说明INI文件没有主键,那么写入主键和键值即可

    Set ForWrite=fso.opentextfile(FilePath,2)

    ForWrite.WriteLine "["& Bar &"]"

    ForWrite.WriteLine PrimaryKey &"="& Value

Else

    Dim sArray

    sArray=split(sRead,"[")

        For i=1 to UBound(sArray)

           If Left(sArray(i),Len(Bar))=Bar then '小节名存在

                 If Instr(sArray(i),PrimaryKey)>0 then  '找到键名

                     Set ForRead=fso.opentextfile(FilePath,1)

                     Do Until ForRead.AtEndOfStream

                     sReadLine = ForRead.ReadLine

                     If Instr(sReadLine,"["& Bar &"]")>0 then

                        While Instr(sReadLine,PrimaryKey)+0<0  '读到键名为止

                           Msgbox sReadLine

                           sReadLine = ForRead.ReadLine

                        Wend

                        stxt = Right(sReadLine,Len(sReadLine)-Left(sReadLine,instr(sReadLine,"=")))

                        Exit do

                     End If

                     Loop

                     sArray(i)=Replace(sArray(i), stxt, Value) '将键值替换为Value

                 Else

                     sArray(i)=Replace(sArray(i),Bar&"]",Bar&"]"& vbcrlf & PrimaryKey &"="& Value)

                 End If

                 BE=1

           Else

           End If

        Next

        If BE=1 then 'BE=1说明小节名存在,用数组配置好了键名与键值

           ForRead.close

           Set ForWrite=fso.opentextfile(FilePath,2) '覆盖原有内容重新写入

           ForWrite.Write ""

           ForWrite.close

           Set ForWrite=fso.opentextfile(FilePath,8) '清空并追加写入内容

           i=0

           For i=1 to UBound(sArray)

           ForWrite.Write "["& sArray(i)

           Next

           ForWrite.close

           Set fso=nothing

           Exit Function

        End If

        ForRead.close   '写入小节名和键值

        Set ForWrite=fso.opentextfile(FilePath,8)

        ForWrite.WriteLine "["& Bar &"]"

        ForWrite.WriteLine PrimaryKey &"="& Value

End If

ForWrite.close

Set fso=nothing

End Function

//===============<得到文件、文件夹字节数>
[VBS得到目标文件字节数]

CODE:

Function ShowFileSize(filespec)

    Dim fso, f, s

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set f = fso.GetFile(filespec)

s = UCase(f.Name) & " 大小为 " & f.size & " 字节。"

ShowFileSize = s 

End Function

[VBS得到目标文件夹下所有文件的字节数]

CODE:

Function ShowFolderSize(filespec)

    Dim fso, f, s

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set f = fso.GetFolder(filespec)

s = UCase(f.Name) & " 大小为 " & f.size & " 字节。"

ShowFolderSize = s 

End Function

//===============<得到文件、文件夹类型>
[VBS得到目标文件类型信息]

CODE:

Function ShowFileType(filespec)

    Dim fso, f, s

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set f = fso.GetFile(filespec)

    s = UCase(f.Name) & " 的类型为 " & f.Type 

ShowFileType = s

End Function

[VBS得到目标文件类型信息]

CODE:

Function ShowFolderType(filespec)

    Dim fso, f, s

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set f = fso.GetFolder(filespec)

    s = UCase(f.Name) & " 的类型为 " & f.Type 

ShowFolderType = s

End Function

//===============<读取文本内容>
[读取文本全部内容、读取文本行]

CODE:

set ttfile=fso.opentextfile(f,forappending)

'读取打开文件的一行并回车(下次读从下一行开始)

read=ttfile.ReadLine

'读取所有文件内容

read=ttfile.ReadAll

[读取文本返回行数, 指定行内容]

CODE:

n=inputbox("请输入要读取的第n行","提示") 

set fso=createobject("scripting.filesystemobject") 

set j=fso.opentextfile("c:\??.txt") 

i=0 

do until j.atendofstream 

h=j.readline 

i=i+1 

loop 

msgbox "共有"&i&"行" 

j.close 

i=0 

set j=fso.opentextfile("c:\??.txt") 

do until j.atendofstream 

h=j.readline 

i=i+1 

if i=n then 

msgbox "第"&n&"行为"&h 

end if 

loop 

j.close

[倒序输出文本行内容]

CODE:

Dim arrFileLines()

i = 0

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile("C:\tt.txt", 1)

Do

    Redim Preserve arrFileLines(i)

    arrFileLines(i) = objFile.ReadLine

    i = i + 1

Loop Until objFile.AtEndOfStream

objFile.Close

For l = Ubound(arrFileLines) to LBound(arrFileLines) Step -1

    Wscript.Echo arrFileLines(l)

Next

.
[获取指定文件的文件名、文件扩展名、完整文件路径等等]

CODE:

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.GetFile("按键精灵.rar")

Wscript.Echo "Absolute path: " & objFSO.GetAbsolutePathName(objFile)

Wscript.Echo "Parent folder: " & objFSO.GetParentFolderName(objFile) 

Wscript.Echo "File name: " & objFSO.GetFileName(objFile)

Wscript.Echo "Base name: " & objFSO.GetBaseName(objFile)

Wscript.Echo "Extension name: " & objFSO.GetExtensionName(objFile)

[解压缩文件夹]

CODE:

strComputer = "."

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colFolders = objWMIService.ExecQuery ("Select * from Win32_Directory where name = 'c:\\Scripts'")

For Each objFolder in colFolders

    errResults = objFolder.Uncompress

    Wscript.Echo errResults

Next

[枚举文件夹属性、详细信息]
'返回字节数、目录、文件夹名称、文件夹创建访问修改时间、路径、所在驱动盘等

CODE:

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder("C:\新建文件夹")

Wscript.Echo "Date created: " & objFolder.DateCreated  '创建时间

Wscript.Echo "Date last accessed: " & objFolder.DateLastAccessed  '最后访问时间

Wscript.Echo "Date last modified: " & objFolder.DateLastModified  '最后修改时间

Wscript.Echo "Drive: " & objFolder.Drive  '所在磁盘

Wscript.Echo "Is root folder: " & objFolder.IsRootFolder  '判断文件夹是否是根文件夹,返回true/false

Wscript.Echo "Name: " & objFolder.Name  '所在文件夹

Wscript.Echo "Parent folder: " & objFolder.ParentFolder  '父文件夹对象

Wscript.Echo "Path: " & objFolder.Path  '路径

Wscript.Echo "Short name: " & objFolder.ShortName  '短文件名

Wscript.Echo "Short path: " & objFolder.ShortPath  '短路径

Wscript.Echo "Size: " & objFolder.Size     '文件大小M

Wscript.Echo "Type: " & objFolder.Type     '字节B

[检索计算机上所有隐藏文件夹路径]

CODE:

strComputer = "."

Set objWMIService = GetObject("winmgmts:" _

    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colFiles = objWMIService.ExecQuery _

    ("Select * from Win32_Directory Where Hidden = True")

For Each objFile in colFiles

    Wscript.Echo objFile.Name

Next

[检索Dll插件版本信息]

CODE:

Set objFSO = CreateObject("Scripting.FileSystemObject")

Wscript.Echo objFSO.GetFileVersion("c:\windows\system32\scrrun.dll")

[去掉指定文件夹下文件或子文件夹的只读属性]

CODE:

CreateObject("WScript.Shell").Run "cmd /c attrib -r 指定目录 /s /d",0
[修改文件、文件夹属性为隐藏或显示]

CODE:

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFile("C:\a.txt")

f.Attributes = f.Attributes - 2  ' - 2 隐藏, + 2 显示

//============<遍历用户桌面文件夹、文件>
'[1] 遍历当前用户(不全)桌面文件

CODE:

Const DESKTOP = &H10&

Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.Namespace(DESKTOP)

Set objFolderItem = objFolder.Self

Set colItems = objFolder.Items

For Each objItem in colItems

    Txt = Txt & objItem.Name & vbcrlf

Next

Msgbox Txt, 64+4096, "结果"

Set objFolderItem = nothing

Set objFolder = nothing

Set objShell = nothing

'
'[2] 遍历所有用户桌面文件
本帖隐藏的内容需要回复才可以浏览'
'[3] 获取桌面路径，GetFolder方法遍历子文件夹、文件

CODE:

Set wshell = CreateObject("WScript.Shell")

PathDesktop = wshell.specialfolders("Desktop")'得到桌面的绝对路径

Dim fso, fc

Set fso = CreateObject("Scripting.FileSystemObject")

Set fs = fso.GetFolder(PathDesktop).SubFolders '遍历子文件夹

SK = vbcrlf & "[文件夹]" & vbcrlf

For Each fls In fs

    SK = SK & fls.Name & vbcrlf

Next

Set fc = fso.GetFolder(PathDesktop).Files '遍历文件夹下的文件

CK = vbcrlf & "[文件]" & vbcrlf

For Each flc In fc

    CK = CK & flc.Name & vbcrlf

Next

txt = SK & CK

Msgbox txt, 64+4096, "结果"

Set wshell = nothing

//============<遍历盘符，递归遍历子目录>

'[1] 遍历计算机磁盘名称

CODE:

Set fso=CreateObject("scripting.filesystemobject") 

Set objdrives = fso.Drives

For Each objdrive In objdrives '遍历磁盘 

TracePrint objdrive 

Next

'[2]递归遍历指定目录下所有子目录(遍历目标文件夹下所有文件夹、子文件夹路径)

CODE:

Msgbox 递归遍历所有子目录("D:\") 

Function 递归遍历所有子目录(目录)

    VBSBegin

        Function GetSubFolders(sPath)

            Set fso = CreateObject("Scripting.FileSystemObject")

            Set sFolder = fso.GetFolder(sPath)

            Set subFolderSet = sFolder.SubFolders

            For Each subFolder in subFolderSet

                'MsgBox "subFolder.Path=" & subFolder.Path

                GetSubFolders = subFolder.Path & vbcrlf & GetSubFolders(subFolder.Path) &  GetSubFolders 

            Next

        End Function

    VBSEnd

    递归遍历所有子目录=GetSubFolders(目录)

End Function

'[3]递归遍历指定目录下所有子目录(遍历目标文件夹下所有文件夹、子文件夹路径)

CODE:

Dim AddStr

VBSBegin

    Function RecSv(CurrentPath) '递归

        Set ABC=CurrentPath.subfolders

        For Each GGMM In ABC

            Set TmpCk=fso.GetFolder(GGMM.path)

            AddStr = AddStr & vbcrlf & TmpCk.path

            Call RecSv(TmpCk)

        Next

        RecSv = AddStr

    End function

VBSEnd 

Set fso=CreateObject("scripting.filesystemobject")

Set SxE=fso.GetFolder("C:\Program Files")

msgbox RecSv(SxE)