心得(3):如何利用VBA的FSO进行文件或者文件夹操作
问题:如何对文件或者文件进行操作,例如:怎么判断文件夹是否存在,怎么创建文件夹等等
解决:利用VBA的FSO 进行操作,这个对象流 包含了各种对文件或者文件夹的操作。简洁实用。
利用VBA进行操作:(继续以之前的条件为例子)
- 如果有些文件不符合规则,那么最好是把他们放在同一个文件夹下,这样子方便操作,利用FSO能很好的做到这一点,FSO就像是Java的对象一样,他有自己的方法有自己的属性
- 首先要创建文件加就可以使用:
这个方式来,先判断,在创建 - 然后定义一些自己的规则,说明那些文件是不符合规则的:
- 然后就是对文件进行操作了,转移文件等:
源码如下:
Sub 批量改名()
Dim mypath As String, myname As String, awbname As String, arg As String
Dim wbcount As Integer, i As Integer
Dim olds As String, news As String
Dim fso
Dim newPath As String
Dim oldPath As String
Dim folderName As String
Dim length As Integer
'关闭excel的刷新
Application.ScreenUpdating = False
'禁止弹出对话框
Application.DisplayAlerts = False
'使用FSO方式进行文件操作
Set fso = CreateObject("Scripting.FileSystemObject")
'得到本文件的相对地址
mypath = ActiveWorkbook.Path
'当前工作的excel的文件名
awbname = ActiveWorkbook.Name
'任意打开文件夹下的某一个文件
wbcount = 0
myname = Dir(mypath & "\" & "*.xlsx")
'定义一个变量为项目的名称(文件中的命名)
arg = ""
'用来存放文件夹的名称
folderName = "C:\Users\25267\Desktop\error"
'判断桌面上是否有一个名为error的文件夹:没有则创建一个,用来存放不符合规则的文件
If NOT fso.FolderExists(folderName) Then
fso.CreateFolder(folderName)
End If
'如果当前的文件名为空的字符串("")表示已经没有更多的文件了跳出循环
Do While myname <> ""
If myname <> awbname Then
'打开当前的文件夹
Set wb = Workbooks.Open(mypath & "\" & myname)
'得到这个文件的项目名的名称
arg = wb.Sheets(1).Range("B5")
wbcount = wbcount + 1
'关闭文件
wb.Close False
'除去arg中命名规则不允许的字符
arg = Replace(arg, "\", "")
arg = Replace(arg, " ", "")
arg = Replace(arg, "/", "")
arg = Replace(arg, "?", "")
arg = Replace(arg, "<", "")
arg = Replace(arg, ">", "")
arg = Replace(arg, "'", "")
arg = Replace(arg, ":", "")
arg = Replace(arg, "*", "")
arg = Replace(arg, """", "")
arg = Replace(arg, ".", "")
arg = Replace(arg, "|", "")
arg = Replace(arg, Chr(10), "")
arg = Replace(arg, Chr(32), "")
'计算这个字符串的字数
length = len(arg)
'如果这个文件的项目名不符合标准则把这个文件转移到指定的位置
If (arg = "") OR (length > 100) Then
oldPath = mypath & "\" & myname
newPath = folderName & "\"
fso.MoveFile oldPath,newPath
Else
olds = mypath & "\" & myname
news = mypath & "\" & arg & ".xlsx"
'将这个文件的名称换成这个项目名
On Error GoTo MyErr '错误导向
Name olds As news
End If
End If
'随机打开本文件夹的另一个文件
myname = Dir
Loop
'结束程序并且恢复之前的操作
MsgBox "一共更改了 " & wbcount & " 个文件"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'因为这个VBA语言到最后会运行错误标志的内容所以在结束后要让他失效
olds = ""
'错误标志
MyErr:
If olds = "" Then
Else
arg = arg & wbcount
news = mypath & "\" & arg & ".xlsx"
Name olds As news
Resume Next
End If
End Sub