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常用技巧代码解析》”