学习笔记 解决方案 by llj1998

10.文件操作——《VBA常用技巧代码解析》

1.导入文本文件

OpenText方法简单直接,但可能会打开新的工作簿窗口。

FSO方法给予你更多对文件读取的控制,但需要逐行处理数据。

ADO方法功能强大,可以处理各种数据源,但设置稍微复杂一些。

还可以使用Add方法新建查询表后导入文本文件，允许我们精确控制导入过程

使用OpenText方法:

Sub ImportTextUsingOpenText()
    ' 使用OpenText方法导入文本文件
    '需要指定导入的文件名，否则报错
    Workbooks.OpenText Filename:=ThisWorkbook.Path & "\文件名.txt", _
        Origin:=936, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1))  ' 可以根据需要调整字段信息
    
    ' 将数据复制到当前工作簿
    ActiveSheet.UsedRange.Copy Destination:=ThisWorkbook.Sheets("Sheet1").Range("A1")
    
    ' 关闭临时打开的工作簿
    ActiveWorkbook.Close SaveChanges:=False
End Sub

使用文件系统对象(FSO)读取文本文件:

'使用文件系统对象(FSO)读取文本文件
Sub ImportTextUsingFSO()
    Dim fso As Object
    Dim textFile As Object
    Dim textLine As String
    Dim row As Long
    
    ' 创建文件系统对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 打开文本文件
    Set textFile = fso.OpenTextFile(ThisWorkbook.Path & "\工资表.txt", 1) ' 1 表示只读模式
    
    row = 1
    ' 逐行读取文本文件并写入Excel
    Do While Not textFile.AtEndOfStream
        textLine = textFile.ReadLine
        ThisWorkbook.Sheets("Sheet1").Cells(row, 1).Value = textLine
        row = row + 1
    Loop
    
    ' 关闭文本文件
    textFile.Close
    
    ' 清理对象
    Set textFile = Nothing
    Set fso = Nothing
End Sub

使用ADO(ActiveX Data Objects)导入:

Sub ImportTextUsingADO()
    Dim conn As Object
    Dim rs As Object
    Dim filePath As String
    
    filePath = ThisWorkbook.Path & "\光大.txt"
    
    ' 创建ADO连接
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & ThisWorkbook.Path & ";" & _
              "Extended Properties=""text;HDR=Yes;FMT=Delimited;CharacterSet=65001"""
    
    ' 执行SQL查询
    Set rs = conn.Execute("SELECT * FROM [" & GetFileName(filePath) & "]")
    
    ' 将结果复制到工作表
    ThisWorkbook.Sheets("Sheet1").Range("A1").CopyFromRecordset rs
    
    ' 清理对象
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
End Sub

Function GetFileName(ByVal filePath As String) As String
    GetFileName = Mid(filePath, InStrRev(filePath, "\") + 1)
End Function

使用Add方法新建查询表后导入文本文件：

Sub ImportTextUsingQueryTable()
    Dim ws As Worksheet
    Dim qt As QueryTable
    Dim filePath As String
    
    ' 设置工作表和文件路径
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    filePath = ThisWorkbook.Path & "\光大.txt"
    
    ' 清除工作表内容
    ws.Cells.Clear
    
    ' 创建并配置查询表
    Set qt = ws.QueryTables.Add( _
        Connection:="TEXT;" & filePath, _
        Destination:=ws.Range("A1"))
    
    With qt
        .Name = "ImportedData"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936  ' 简体中文 Windows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)  ' 假设所有列都是文本格式
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    ' 删除查询表定义，但保留数据
    qt.Delete
    
    MsgBox "数据已成功导入！", vbInformation
End Sub

2.将数据写入文本文件

使用Print#语句将数据写入文本文件

在VBA中，Print语句用于将数据写入已打开的文件中

基本语法：Print #文件编号, 数据

特点：每次Print后，光标会自动移动到下一行

分隔符：如果要在一行中打印多个项目，可以使用分号（；）来分隔它们，例如：

Print #fileNum, “项目1”; “项目2”; “项目3”

‘这会在同一行打印这3个项目，中间没有分隔符

可以使用Tab()函数或Spc()函数来控制输出格式

避免自动换行：如果不想再打印后自动换行，可以在Print语句后面加上分号，例如：

Print #fileNum, “这不会换行”;

Sub 写入数据到文本文件()
    On Error GoTo ErrorHandler
    
    ' 声明变量
    Dim fileNum As Integer
    Dim filePath As String
    Dim i As Long, lastRow As Long
    
    ' 显示开始执行的消息
    'MsgBox "开始执行代码", vbInformation
    
    ' 设置文件路径为当前工作簿所在的文件夹
    filePath = ThisWorkbook.Path & "\输出数据.txt"
    
    ' 显示文件路径
    MsgBox "文件将被保存到: " & filePath, vbInformation
    
    ' 获取一个可用的文件编号
    fileNum = FreeFile
    
    ' 打开文件准备写入，如果文件不存在则创建新文件
    Open filePath For Output As #fileNum
    
    ' 获取当前工作表的最后一行
    lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    
    ' 循环遍历每一行并写入文件
    For i = 1 To lastRow
        ' 写入A列和B列的数据，用逗号分隔
        Print #fileNum, ActiveSheet.Cells(i, 1).Value & "," & ActiveSheet.Cells(i, 2).Value
    Next i
    
    ' 关闭文件
    Close #fileNum
    
    ' 检查文件是否成功创建
    If Dir(filePath) <> "" Then
        MsgBox "文件成功创建在: " & filePath, vbInformation
    Else
        MsgBox "文件创建失败", vbCritical
    End If
    
    Exit Sub

ErrorHandler:
    MsgBox "发生错误: " & Err.Description, vbCritical
    If fileNum > 0 Then Close #fileNum
End Sub

另存为文本文件

使用SaveAs方法将工作表另存为文本文件

Sub 将工作表保存为文本文件()
    ' 声明变量
    Dim ws As Worksheet
    Dim saveFilePath As String
    Dim currentFilePath As String
    
    ' 设置要保存的工作表
    Set ws = ThisWorkbook.ActiveSheet
    
    ' 获取当前工作簿的路径
    currentFilePath = ThisWorkbook.Path
    
    ' 设置保存路径和文件名
    saveFilePath = currentFilePath & "\" & ws.Name & ".txt"
    
    ' 使用SaveAs方法将工作表保存为文本文件
    ws.SaveAs Filename:=saveFilePath, FileFormat:=xlText, CreateBackup:=False
    
    ' 提示用户操作完成
    MsgBox "工作表 '" & ws.Name & "' 已成功保存为文本文件：" & vbNewLine & saveFilePath, vbInformation
    
    ' 可选：如果想在保存后重新打开Excel文件，取消注释下面的行
    ' ThisWorkbook.Activate
End Sub

3.文件修改的日期和时间

在VBA过程中如果需要获得文件最后修改的日期和时间，可以使用FileDateTime函数

基本语法：FileDateTime(pathname)

其中pathname是一个字符串的表达式，指定文件的名称和路径

Sub 获取文件最后修改时间()
    ' 声明变量
    Dim filePath As String
    Dim lastModified As Date
    
    ' 指定要检查的文件路径
    filePath = ThisWorkbook.Path & "\测试文件.xlsx"
    
    ' 使用FileDateTime获取文件的最后修改时间
    lastModified = FileDateTime(filePath)
    
    ' 显示结果
    MsgBox "文件 '" & filePath & "' 的最后修改时间是: " & _
           Format(lastModified, "yyyy-mm-dd hh:mm:ss"), vbInformation
    
    ' 可选：将结果写入当前工作表
    ActiveSheet.Cells(1, 1).Value = "文件路径"
    ActiveSheet.Cells(1, 2).Value = "最后修改时间"
    ActiveSheet.Cells(2, 1).Value = filePath
    ActiveSheet.Cells(2, 2).Value = lastModified
End Sub

4.查找文件或文件夹

在磁盘中查找文件或文件夹，可以使用Dir函数

Dir函数用于返回一个字符串，表示匹配指定路径或文件模式的文件、目录或文件夹的名称，它可以用来检查特定文件是否存在，或者遍历目录中的文件。

基本语法：Dir(pathname [, attributes])

pathname：文件名或路径，可以包含通配符*和?

attributes：可选参数，用于指定文件属性

常用的attributes常量：

vbNormal (0): 普通文件，没有其他属性设置。

vbReadOnly (1): 只读文件。

vbHidden (2): 隐藏文件。

vbSystem (4): 系统文件。

vbDirectory (16): 文件夹或目录。

vbArchive (32): 存档文件。

查找只读文件

Sub 查找只读文件()
    Dim folderPath As String
    Dim fileName As String
    
    folderPath = "C:\Example\"
    fileName = Dir(folderPath & "*.*", vbReadOnly)
    
    Do While fileName <> ""
        Debug.Print "找到只读文件: " & fileName
        fileName = Dir()
    Loop
End Sub

Dir函数的返回值：

当文件存在时，Dir函数会返回与指定路径匹配的文件名（不包括路径）。

当文件不存在时，Dir函数会返回一个空字符串 (“”)。

检查特定文件是否存在
Sub 检查文件是否存在()
    Dim filePath As String
    Dim fileExists As String
    
    filePath = "C:\Example\test.xlsx"
    fileExists = Dir(filePath)
    
    If fileExists <> "" Then
        MsgBox "文件存在！", vbInformation
    Else
        MsgBox "文件不存在。", vbExclamation
    End If
End Sub
遍历文件夹中的所有Excel文件
Sub 列出Excel文件()
    Dim folderPath As String
    Dim fileName As String
    Dim row As Integer
    Dim fileCount As Integer
    
    ' 清除当前工作表内容
    ActiveSheet.Cells.Clear
    
    folderPath = "F:\备份\文档\"  ' 添加末尾的反斜杠
    
    On Error Resume Next  ' 启用错误处理
    fileName = Dir(folderPath & "*.xls*")
    If Err.Number <> 0 Then
        MsgBox "错误: " & Err.Description, vbExclamation
        Exit Sub
    End If
    On Error GoTo 0  ' 禁用错误处理
    
    row = 1
    fileCount = 0
    
    ' 添加表头
    ActiveSheet.Cells(row, 1).Value = "文件名"
    row = row + 1
    
    While fileName <> ""
        ' 将文件名写入当前工作表
        ActiveSheet.Cells(row, 1).Value = fileName
        row = row + 1
        fileCount = fileCount + 1
        fileName = Dir()
    Wend
    
    If fileCount > 0 Then
        MsgBox "文件列表已生成！共找到 " & fileCount & " 个文件。", vbInformation
    Else
        MsgBox "未找到任何Excel文件。请检查文件夹路径和文件类型。", vbExclamation
    End If
End Sub
查找包含特定文本的文件

（这段代码好像没运行成功）

Sub t()
    Dim folderPath As String
    Dim searchText As String
    Dim fileName As String

    folderPath = "F:\备份\文档\"
    searchText = "test"
    fileName = Dir(folderPath & "*.xls*")

    Do While fileName <> ""
        If InStr(fileName, searchText) > 0 Then
            MsgBox "找到匹配的文件：" & fileName, vbInformation
            Exit Sub
        End If
        fileName = Dir
    Loop

    MsgBox "未找到包含 '" & searchText & "' 的Excel文件。", vbExclamation
End Sub

5.获得当前文件夹的名称

在处理文件时经常需要获得当前文件夹的名称，此时可以使用CurDir函数

CurDir函数返回当前路径（当前工作目录）的字符串

基本语法：CurDir([drive])

drive是卡选参数，指定驱动器的字母（例如C），如果省略，则返回当前驱动器的当前目录

获取当前工作目录

Sub 获取当前目录()
    Dim currentPath As String
    
    currentPath = CurDir()
    MsgBox "当前工作目录是: " & currentPath, vbInformation
End Sub

6.创建和删除文件夹

通过MkDir函数创建文件夹
Sub 简单创建文件夹()
    ' 声明变量
    Dim folderPath As String
    
    ' 设置要创建的文件夹路径
    folderPath = "C:\测试文件夹"
    
    ' 创建文件夹
    On Error Resume Next  ' 忽略可能的错误（如文件夹已存在）
    MkDir folderPath
    
    ' 检查文件夹是否成功创建
    If Dir(folderPath, vbDirectory) = "" Then
        MsgBox "无法创建文件夹。它可能已经存在或您没有足够的权限。", vbExclamation
    Else
        MsgBox "文件夹已成功创建！", vbInformation
    End If
End Sub
通过RmDir函数删除文件夹
Sub 简单删除文件夹()
    ' 声明变量
    Dim folderPath As String
    
    ' 设置要删除的文件夹路径
    folderPath = "C:\测试文件夹"
    
    ' 检查文件夹是否存在
    If Dir(folderPath, vbDirectory) <> "" Then
        ' 删除文件夹
        RmDir folderPath
        MsgBox "文件夹已成功删除！", vbInformation
    Else
        MsgBox "文件夹不存在！", vbExclamation
    End If
End Sub

7.重命名文件或文件夹

使用Name语句可以重命名文件或文件夹

语法：Name 旧名称 As 新名称

重命名文件：

Sub 重命名文件()
    ' 声明变量
    Dim oldName As String
    Dim newName As String
    
    ' 设置旧文件名（包括完整路径）
    oldName = "C:\测试文件夹\旧文件名.txt"
    
    ' 设置新文件名（包括完整路径）
    newName = "C:\测试文件夹\新文件名.txt"
    
    ' 使用错误处理来捕获可能的问题
    On Error Resume Next
    
    ' 重命名文件
    Name oldName As newName
    
    ' 检查是否有错误发生
    If Err.Number = 0 Then
        MsgBox "文件重命名成功！", vbInformation
    Else
        MsgBox "重命名失败。错误: " & Err.Description, vbExclamation
    End If
    
    ' 重置错误处理
    On Error GoTo 0
End Sub

重命名文件夹：

Sub 重命名文件夹()
    ' 声明变量
    Dim oldName As String
    Dim newName As String
    
    ' 设置旧文件夹名（包括完整路径）
    oldName = "C:\旧文件夹名"
    
    ' 设置新文件夹名（包括完整路径）
    newName = "C:\新文件夹名"
    
    ' 使用错误处理来捕获可能的问题
    On Error Resume Next
    
    ' 重命名文件夹
    Name oldName As newName
    
    ' 检查是否有错误发生
    If Err.Number = 0 Then
        MsgBox "文件夹重命名成功！", vbInformation
    Else
        MsgBox "重命名失败。错误: " & Err.Description, vbExclamation
    End If
    
    ' 重置错误处理
    On Error GoTo 0
End Sub

8.复制指定的文件

如果需要把文件从一个地方复制到另一个地方，可以使用FileCopy语句复制文件

FileCopy语句基本语法：

FileCopy 源文件路径, 目标文件路径

Sub 复制文件()
    ' 声明变量
    Dim sourceFile As String
    Dim destinationFile As String
    
    ' 设置源文件路径
    sourceFile = "C:\源文件夹\源文件.txt"
    
    ' 设置目标文件路径
    destinationFile = "D:\目标文件夹\目标文件.txt"
    
    ' 使用错误处理
    On Error Resume Next
    
    ' 复制文件
    FileCopy sourceFile, destinationFile
    
    ' 检查是否有错误发生
    If Err.Number = 0 Then
        MsgBox "文件复制成功！", vbInformation
    Else
        MsgBox "复制失败。错误: " & Err.Description, vbExclamation
    End If
    
    ' 重置错误处理
    On Error GoTo 0
End Sub

9.删除指定的文件

可以使用Kill方法删除指定的文件

Kill方法基本语法：

Kill 文件路径

Sub 删除文件()
    ' 声明变量
    Dim filePath As String
    
    ' 设置要删除的文件路径
    filePath = "C:\测试文件夹\要删除的文件.txt"
    
    ' 使用错误处理
    On Error Resume Next
    
    ' 检查文件是否存在
    If Dir(filePath) <> "" Then
        ' 文件存在，尝试删除
        Kill filePath
        
        ' 检查是否有错误发生
        If Err.Number = 0 Then
            MsgBox "文件已成功删除！", vbInformation
        Else
            MsgBox "删除失败。错误: " & Err.Description, vbExclamation
        End If
    Else
        MsgBox "文件不存在。", vbExclamation
    End If
    
    ' 重置错误处理
    On Error GoTo 0
End Sub

1 thought on “10.文件操作——《VBA常用技巧代码解析》”

  1. Pingback： 《VBA常用技巧代码解析》·索引 – 李灵杰

发表回复