f321wn / excel / Excel VBA

分享

   

Excel VBA

2020-10-12  f321wn

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

Dir 函数

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

语法

Dir[(pathname[, attributes])]

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

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

[vb]  view plain  copy
  1. Sub OpenAndClose()  
  2.     Dim MyFile As String  
  3.     Dim s As String  
  4.     Dim count As Integer  
  5.     MyFile = Dir('C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\' & '*.xlsx')  
  6.     '读入文件夹中的第一个.xlsx文件  
  7.     count = count + 1       '记录文件的个数  
  8.     s = s & count & '、' & MyFile  
  9.     Do While MyFile <> ''  
  10.         MyFile = Dir        '第二次读入的时候不用写参数  
  11.         If MyFile = '' Then  
  12.             Exit Do         '当MyFile为空的时候就说明已经遍历完了,这时退出Do,否则还要运行一遍  
  13.         End If  
  14.         count = count + 1  
  15.         If count Mod 2 <> 1 Then  
  16.             s = s & vbTab & count & '、' & MyFile  
  17.         Else  
  18.             s = s & vbCrLf & count & '、' & MyFile  
  19.         End If  
  20.     Loop  
  21.     Debug.Print s  
  22. End Sub  

运行结果如下:

53、

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

[vb]  view plain  copy
  1. Sub OpenCloseArray()  
  2.     Dim MyFile As String  
  3.     Dim Arr(100) As String  
  4.     Dim count As Integer  
  5.     MyFile = Dir('C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\' & '*.xlsx')  
  6.     count = count + 1  
  7.     Arr(count) = MyFile  
  8.       
  9.     Do While MyFile <> ''  
  10.         MyFile = Dir  
  11.         If MyFile = '' Then  
  12.             Exit Do  
  13.         End If  
  14.         count = count + 1  
  15.         Arr(count) = MyFile         '将文件的名字存在数组中  
  16.     Loop  
  17.       
  18.     For i = 1 To count  
  19.         Workbooks.Open Filename:='C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\' & Arr(i)  '循环打开Excel文件  
  20.             Cells(1, 1) = 'alex_bn_lee'             '修改打开文件的内容  
  21.         ActiveWorkbook.Close savechanges = True     '关闭打开的文件  
  22.     Next  
  23. End Sub  

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

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

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

[vb]  view plain  copy
  1. Sub dlkfjdl()  
  2.     Dim MyFile As String  
  3.     Dim count As Integer  
  4.     count = 1  
  5.     MyFile = Dir('C:\Users\McDelfino\Desktop\桌面\Excel\*.*')  
  6.     Debug.Print '1、' & MyFile  
  7.     Do While MyFile <> ''  
  8.         count = count + 1  
  9.         MyFile = Dir  
  10.         If MyFile = '' Then Exit Do  
  11.         Debug.Print count & '、' & MyFile  
  12.     Loop  
  13. End Sub  

 批量建立TXT文件  

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

[vb]  view plain  copy
  1. Sub kdjfl()  
  2.     For i = 1 To 10  
  3.         Open 'C:\Users\McDelfino\Desktop\练习\' & Format(i, '00') & '.txt' For Output As #i  
  4.         Print #i, i  
  5.         Close #i  
  6.     Next  
  7. End Sub  

 GetFolder方法

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

 遍历文件夹内的所有文件 

[vb]  view plain  copy
  1. Sub GetFiles()  
  2.     Dim fs, f, f1, fc  
  3.     Set fs = CreateObject('scripting.filesystemobject')  
  4.     Set f = fs.getfolder('F:\Desktop\2.wind_numerical_excello')  
  5.     Set fc = f.Files  
  6.   
  7.     For Each f1 In fc  
  8.         Debug.Print f1  
  9.         Debug.Print 'f1 = ' & TypeName(f1)  
  10.     Next  
  11.       
  12.     MsgBox 'fs = ' & TypeName(fs) _  
  13.     & vbCrLf & 'f = ' & TypeName(f) _  
  14.     & vbCrLf & 'fc = ' & TypeName(fc)  
  15.       
  16. End Sub  

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

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

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

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

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

[vb]  view plain  copy
  1. Sub djkflds()  
  2.     Dim fso, fd, fs, f, ft, s  
  3.     Set fso = CreateObject('Scripting.FileSystemObject')  
  4.       
  5.     fso.MoveFile 'F:\Desktop\1.xlsx''F:\Desktop\2.wind_numerical_excello\1.xlsx'  
  6.     '移动文件  
  7.        
  8.     fso.MoveFolder 'F:\Desktop\temp''F:\Desktop\2.wind_numerical_excello\temp'  
  9.     '移动文件夹  
  10.       
  11.     MsgBox fso.FileExists('F:\Desktop\1.xlsx')  
  12.     '判断文件是否存在,存在返回True,否则返回False  
  13.       
  14.     MsgBox fso.FolderExists('F:\Desktop\temp')  
  15.     '判断文件夹是否存在,存在返回True,否则返回False  
  16.      
  17.     Set ft = fso.OpenTextFile('F:\Desktop\1.txt', 8, -2)  
  18.     '8打开一个文件并写到文件的尾部 -2使用系统缺省打开文件  
  19.     'ft是TextStream对象,加快对文件的顺序访问  
  20.     ft.Write 'Hello World'      'Write方法,在一行上  
  21.     For i = 1 To 10  
  22.         ft.WriteLine i          'WriteLien方法,另起一行  
  23.     Next  
  24.     ft.Close                    'Close方法,关闭文件  
  25.       
  26.     fso.DeleteFolder 'F:\Desktop\1'  
  27.     '删除一个文件夹,并且是不放在回收站里面的  
  28.   
  29. End Sub  


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


 Size方法

[vb]  view plain  copy
  1. Sub GetSize()  
  2.     Dim fso, fd, fs, f  
  3.     Set fso = CreateObject('Scripting.FileSystemObject')  
  4.     Set fd = fso.GetFolder('F:\Desktop\2.wind_numerical_excello')  
  5.     Set fs = fd.SubFolders  
  6.     For Each f In fs  
  7.         Debug.Print f.Name, Format(f.Size / 1024 / 1024, '#.##') & 'M'  
  8.     Next  
  9. End Sub  


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

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


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

[vb]  view plain  copy
  1. Sub getfiles()  
  2.     Dim fso, folder, fds, fd, folder2, fs, f  
  3.     Set fso = CreateObject('Scripting.FileSystemObject')  
  4.     Set folder1 = fso.GetFolder('F:\Desktop\2.wind_numerical_excello')  '获得文件夹  
  5.     Set fds = folder1.subfolders        '子文件夹集合  
  6.     For Each fd In fds                  '遍历子文件夹  
  7.         Debug.Print fd.Name  
  8.         Set folder2 = fd                '获得文件夹2  
  9.         Set fs = folder2.Files          '文件集合  
  10.         For Each f In fs                '遍历文件  
  11.             Debug.Print f.Name  
  12.         Next  
  13.         Debug.Print  
  14.     Next  
  15. End Sub  

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。如发现有害或侵权内容,请点击这里 或 拨打24小时举报电话:4000070609 与我们联系。

    来自: f321wn > 《excel》

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多
    喜欢该文的人也喜欢 更多

    ×
    ×

    ¥.00

    微信或支付宝扫码支付:

    开通即同意《个图VIP服务协议》

    全部>>