vbs 文件操作集合代码

2026-03-31 14:51:01发布 0次浏览

详情描述

1. 文件和文件夹操作

创建文件

Set fso = CreateObject("Scripting.FileSystemObject")

' 创建文本文件
Set file = fso.CreateTextFile("C:\test.txt", True)
file.WriteLine "Hello World"
file.Close

' 创建空文件
fso.CreateTextFile("C:\empty.txt")

读取文件

Set fso = CreateObject("Scripting.FileSystemObject")

' 读取整个文件
Set file = fso.OpenTextFile("C:\test.txt", 1)
content = file.ReadAll
file.Close
MsgBox content

' 逐行读取
Set file = fso.OpenTextFile("C:\test.txt", 1)
Do Until file.AtEndOfStream
    line = file.ReadLine
    MsgBox line
Loop
file.Close

写入/追加文件

Set fso = CreateObject("Scripting.FileSystemObject")

' 覆盖写入
Set file = fso.OpenTextFile("C:\test.txt", 2, True)
file.WriteLine "New content"
file.Close

' 追加写入
Set file = fso.OpenTextFile("C:\test.txt", 8, True)
file.WriteLine "Appended line"
file.Close

复制、移动、删除文件

Set fso = CreateObject("Scripting.FileSystemObject")

' 复制文件
fso.CopyFile "C:\source.txt", "D:\dest.txt"

' 移动文件
fso.MoveFile "C:\old.txt", "D:\new.txt"

' 删除文件
fso.DeleteFile "C:\test.txt"

' 检查文件是否存在
If fso.FileExists("C:\test.txt") Then
    MsgBox "文件存在"
Else
    MsgBox "文件不存在"
End If

获取文件信息

Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.GetFile("C:\test.txt")

MsgBox "文件名: " & file.Name
MsgBox "路径: " & file.Path
MsgBox "大小: " & file.Size & " bytes"
MsgBox "创建时间: " & file.DateCreated
MsgBox "修改时间: " & file.DateLastModified

2. 文件夹操作

创建文件夹

Set fso = CreateObject("Scripting.FileSystemObject")

' 创建单级文件夹
fso.CreateFolder("C:\NewFolder")

' 创建多级文件夹（需要检查是否存在）
If Not fso.FolderExists("C:\Level1\Level2") Then
    fso.CreateFolder("C:\Level1\Level2")
End If

遍历文件夹

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("C:\Test")

' 列出所有文件
For Each file In folder.Files
    MsgBox "文件: " & file.Name
Next

' 列出所有子文件夹
For Each subfolder In folder.SubFolders
    MsgBox "子文件夹: " & subfolder.Name
Next

复制、移动、删除文件夹

Set fso = CreateObject("Scripting.FileSystemObject")

' 复制文件夹
fso.CopyFolder "C:\SourceFolder", "D:\DestFolder"

' 移动文件夹
fso.MoveFolder "C:\OldFolder", "D:\NewFolder"

' 删除文件夹
fso.DeleteFolder "C:\TempFolder"

' 清空文件夹（删除所有内容）
If fso.FolderExists("C:\Temp") Then
    fso.DeleteFolder "C:\Temp"
    fso.CreateFolder "C:\Temp"
End If

3. 高级文件操作

文件编码处理

Set fso = CreateObject("Scripting.FileSystemObject")

' 指定编码写入（UTF-8）
Set stream = CreateObject("ADODB.Stream")
stream.Type = 2 ' 文本类型
stream.Charset = "UTF-8"
stream.Open
stream.WriteText "UTF-8内容"
stream.SaveToFile "C:\utf8.txt", 2
stream.Close

' 读取不同编码文件
Set stream = CreateObject("ADODB.Stream")
stream.Type = 2
stream.Charset = "GB2312" ' 中文编码
stream.Open
stream.LoadFromFile "C:\gb2312.txt"
content = stream.ReadText
stream.Close
MsgBox content

二进制文件操作

' 二进制读取
Set stream = CreateObject("ADODB.Stream")
stream.Type = 1 ' 二进制类型
stream.Open
stream.LoadFromFile "C:\binary.dat"
binaryData = stream.Read
stream.Close

' 二进制写入
Set stream = CreateObject("ADODB.Stream")
stream.Type = 1
stream.Open
stream.Write binaryData
stream.SaveToFile "C:\output.dat", 2
stream.Close

4. 实用函数集合

查找文件

Function FindFiles(folderPath, filePattern)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)
    Set files = folder.Files

    Dim result()
    ReDim result(0)

    For Each file In files
        If InStr(1, file.Name, filePattern, 1) > 0 Then
            ReDim Preserve result(UBound(result) + 1)
            result(UBound(result)) = file.Path
        End If
    Next

    ' 递归搜索子文件夹
    For Each subfolder In folder.SubFolders
        Dim subResult
        subResult = FindFiles(subfolder.Path, filePattern)
        If UBound(subResult) > 0 Then
            For i = 1 To UBound(subResult)
                ReDim Preserve result(UBound(result) + 1)
                result(UBound(result)) = subResult(i)
            Next
        End If
    Next

    FindFiles = result
End Function

文件批量处理

Sub BatchProcessFiles(folderPath, extension)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)

    For Each file In folder.Files
        If LCase(Right(file.Name, Len(extension))) = LCase(extension) Then
            ' 处理每个文件
            ProcessFile file.Path
        End If
    Next
End Sub

Sub ProcessFile(filePath)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.OpenTextFile(filePath, 1)
    content = file.ReadAll
    file.Close

    ' 处理内容（示例：替换文本）
    newContent = Replace(content, "old", "new")

    Set file = fso.OpenTextFile(filePath, 2)
    file.Write newContent
    file.Close
End Sub

创建日志文件

Sub WriteLog(logFile, message)
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' 确保日志文件夹存在
    logFolder = fso.GetParentFolderName(logFile)
    If Not fso.FolderExists(logFolder) Then
        fso.CreateFolder(logFolder)
    End If

    timestamp = Now()
    logEntry = timestamp & " - " & message

    Set file = fso.OpenTextFile(logFile, 8, True)
    file.WriteLine logEntry
    file.Close
End Sub

5. 完整示例：文件备份脚本

' 文件备份脚本
Option Explicit

Dim fso, sourceFolder, backupFolder, dateStamp

Set fso = CreateObject("Scripting.FileSystemObject")
sourceFolder = "C:\MyDocuments"
dateStamp = Year(Now) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2)
backupFolder = "D:\Backup\" & dateStamp

' 创建备份文件夹
If Not fso.FolderExists(backupFolder) Then
    fso.CreateFolder(backupFolder)
End If

' 备份所有文件
BackupFiles sourceFolder, backupFolder

MsgBox "备份完成！"

Sub BackupFiles(src, dest)
    Dim folder, file, subfolder

    Set folder = fso.GetFolder(src)

    ' 复制文件
    For Each file In folder.Files
        On Error Resume Next
        fso.CopyFile file.Path, dest & "\" & file.Name, True
        If Err.Number <> 0 Then
            WriteLog "错误: " & Err.Description & " - " & file.Path
        End If
        On Error GoTo 0
    Next

    ' 递归处理子文件夹
    For Each subfolder In folder.SubFolders
        Dim newDest
        newDest = dest & "\" & subfolder.Name

        If Not fso.FolderExists(newDest) Then
            fso.CreateFolder(newDest)
        End If

        BackupFiles subfolder.Path, newDest
    Next
End Sub

Sub WriteLog(message)
    Dim logFile
    logFile = "C:\backup.log"

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.OpenTextFile(logFile, 8, True)
    file.WriteLine Now & " - " & message
    file.Close
End Sub