Excel VBA

您所在的位置:网站首页 vba关闭当前文件并删除 Excel VBA

Excel VBA

2023-11-11 18:44| 来源: 网络整理| 查看: 265

我们可能会经常要将一个文件夹中的所有文件都遍历一遍,然后进行修改,下面就介绍用Dir函数实现遍历*.xlsx文件的方法

Dir 函数

返回一个 String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配。

语法

Dir[(pathname[, attributes])]

第一个参数即是文件的地址,第一次引用的时候要标注,第二次用的时候就不必指出了,下面举个例子,遍历下面文件夹中的Excel2010文件,然后输出文件的名字~

 批量遍历某类文件(*.xlsx) 

Sub OpenAndClose() Dim MyFile As String Dim s As String Dim count As Integer MyFile = Dir("C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\" & "*.xlsx") '读入文件夹中的第一个.xlsx文件 count = count + 1 '记录文件的个数 s = s & count & "、" & MyFile Do While MyFile "" MyFile = Dir '第二次读入的时候不用写参数 If MyFile = "" Then Exit Do '当MyFile为空的时候就说明已经遍历完了,这时退出Do,否则还要运行一遍 End If count = count + 1 If count Mod 2 1 Then s = s & vbTab & count & "、" & MyFile Else s = s & vbCrLf & count & "、" & MyFile End If Loop Debug.Print s End Sub

运行结果如下:

53、

遍历每个文件,并且修改文件,先将文件的名字存在数组中,然后通过数组遍历打开每个文件,修改,再关闭文件~

Sub OpenCloseArray() Dim MyFile As String Dim Arr(100) As String Dim count As Integer MyFile = Dir("C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\" & "*.xlsx") count = count + 1 Arr(count) = MyFile Do While MyFile "" MyFile = Dir If MyFile = "" Then Exit Do End If count = count + 1 Arr(count) = MyFile '将文件的名字存在数组中 Loop For i = 1 To count Workbooks.Open Filename:="C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\" & Arr(i) '循环打开Excel文件 Cells(1, 1) = "alex_bn_lee" '修改打开文件的内容 ActiveWorkbook.Close savechanges = True '关闭打开的文件 Next End Sub

要是想要修改每个工作簿的内容可以这样遍历一下,显示将文件夹中的工作簿的名字存到一个字符串数组中,然后在用For...Next语句遍历

 批量遍历某个文件夹中的所有文件(*.*) 

注意:遍历的时候,顺序完全是按照文件名的顺序排的,而不是按照文件夹中文件的顺序~

Sub dlkfjdl() Dim MyFile As String Dim count As Integer count = 1 MyFile = Dir("C:\Users\McDelfino\Desktop\桌面\Excel\*.*") Debug.Print "1、" & MyFile Do While MyFile "" count = count + 1 MyFile = Dir If MyFile = "" Then Exit Do Debug.Print count & "、" & MyFile Loop End Sub

 批量建立TXT文件  

批量建立,同时可以批量赋值到文本文件中~

Sub kdjfl() For i = 1 To 10 Open "C:\Users\McDelfino\Desktop\练习\" & Format(i, "00") & ".txt" For Output As #i Print #i, i Close #i Next End Sub

 GetFolder方法

返回一个和指定路径中文件夹相对应的 Folder 对象。应用于FileSystemObject对象~

 遍历文件夹内的所有文件 

Sub GetFiles() Dim fs, f, f1, fc Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder("F:\Desktop\2.wind_numerical_excello") Set fc = f.Files For Each f1 In fc Debug.Print f1 Debug.Print "f1 = " & TypeName(f1) Next MsgBox "fs = " & TypeName(fs) _ & vbCrLf & "f = " & TypeName(f) _ & vbCrLf & "fc = " & TypeName(fc) End Sub

fs = FileSystemObject对象:提供对计算机文件系统的访问。

f = Folder对象:提供对一个文件夹所有属性的访问。

fc = Files集合:在一个文件夹内的所有 File 对象的集合。

f1 = File对象:提供对文件所有属性的访问。

 FileSystemObject对象及TextStream对象的方法举例:

Sub djkflds() Dim fso, fd, fs, f, ft, s Set fso = CreateObject("Scripting.FileSystemObject") fso.MoveFile "F:\Desktop\1.xlsx", "F:\Desktop\2.wind_numerical_excello\1.xlsx" '移动文件 fso.MoveFolder "F:\Desktop\temp", "F:\Desktop\2.wind_numerical_excello\temp" '移动文件夹 MsgBox fso.FileExists("F:\Desktop\1.xlsx") '判断文件是否存在,存在返回True,否则返回False MsgBox fso.FolderExists("F:\Desktop\temp") '判断文件夹是否存在,存在返回True,否则返回False Set ft = fso.OpenTextFile("F:\Desktop\1.txt", 8, -2) '8打开一个文件并写到文件的尾部 -2使用系统缺省打开文件 'ft是TextStream对象,加快对文件的顺序访问 ft.Write "Hello World" 'Write方法,在一行上 For i = 1 To 10 ft.WriteLine i 'WriteLien方法,另起一行 Next ft.Close 'Close方法,关闭文件 fso.DeleteFolder "F:\Desktop\1" '删除一个文件夹,并且是不放在回收站里面的 End Sub

  Folder对象的属性和方法举例:

 Size方法

Sub GetSize() Dim fso, fd, fs, f Set fso = CreateObject("Scripting.FileSystemObject") Set fd = fso.GetFolder("F:\Desktop\2.wind_numerical_excello") Set fs = fd.SubFolders For Each f In fs Debug.Print f.Name, Format(f.Size / 1024 / 1024, "#.##") & "M" Next End Sub

  File对象的属性和方法举例:

属性和方法与Folder对象类似~

遍历文件夹中的子文件夹及文件

Sub getfiles() Dim fso, folder, fds, fd, folder2, fs, f Set fso = CreateObject("Scripting.FileSystemObject") Set folder1 = fso.GetFolder("F:\Desktop\2.wind_numerical_excello") '获得文件夹 Set fds = folder1.subfolders '子文件夹集合 For Each fd In fds '遍历子文件夹 Debug.Print fd.Name Set folder2 = fd '获得文件夹2 Set fs = folder2.Files '文件集合 For Each f In fs '遍历文件 Debug.Print f.Name Next Debug.Print Next End Sub



【本文地址】


今日新闻


推荐新闻


CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3