利用VBA移动文件，创建文件

心得(3)：如何利用VBA的FSO进行文件或者文件夹操作

问题：如何对文件或者文件进行操作，例如：怎么判断文件夹是否存在，怎么创建文件夹等等

解决：利用VBA的FSO 进行操作，这个对象流 包含了各种对文件或者文件夹的操作。简洁实用。

利用VBA进行操作：（继续以之前的条件为例子）

1. 如果有些文件不符合规则，那么最好是把他们放在同一个文件夹下，这样子方便操作，利用FSO能很好的做到这一点，FSO就像是Java的对象一样，他有自己的方法有自己的属性
2. 首先要创建文件加就可以使用：
   
   这个方式来，先判断，在创建
3. 然后定义一些自己的规则，说明那些文件是不符合规则的：
   
4. 然后就是对文件进行操作了，转移文件等：
   

源码如下：

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