VBA基础知识整理（文件操作）

文件操作

'1 判断A.Xls文件是否存在

    Sub W1()
     If Len(Dir("d:/A.xls")) = 0 Then
       MsgBox "A文件不存在"
     Else
       MsgBox "A文件存在"
     End If
   End Sub

'2 判断A.Xls文件是否打开

Sub W2()
 Dim X As Integer
  For X = 1 To Windows.Count
    If Windows(X).Caption = "A.XLS" Then
      MsgBox "A文件打开了"
      Exit Sub
    End If
  Next
End Sub

'3 excel文件新建和保存

  Sub W3()
     Dim wb As Workbook
     Set wb = Workbooks.Add
       wb.Sheets("sheet1").Range("a1") = "abcd"
'    wb.SaveAs "D:/B.xls"
    wb.SaveAs ("D:/C.xls")
  End Sub

'4 excel文件打开和关闭

 Sub w4()
    Dim wb As Workbook
    Set wb = Workbooks.Open("D:/B.xls")
    MsgBox wb.Sheets("sheet1").Range("a1").Value
    wb.Close False
 End Sub

'5 excel文件保存和备份

Sub w5()
      Dim wb As Workbook
      Set wb = ThisWorkbook
      wb.Save
      wb.SaveCopyAs "D:/ABC.xls"
   End Sub

'6 excel文件复制和删除

  Sub W6()
      FileCopy "D:/ABC.XLS", "E:/ABCd.XLS"
      Kill "D:/ABC.XLS"
   End Sub
   Sub killFile()
   	  Kill ("D:/D.xls")
   End Sub

文件夹基本操作
'1 判断文件夹是否存在
'dir函数的第二个参数是vbdirectory时可以返回路径下的指定文件和文件夹，如果结果为""，则表示不存在。

 Sub w1()
    If Dir(ThisWorkbook.path & "\2011年报表2", vbDirectory) = "" Then
       MsgBox "不存在"
    Else
       MsgBox "存在"
    End If
  End Sub

'2 新建文件夹
'Mikdir语句可以创建一个文件夹

Sub w2()
  MkDir ThisWorkbook.path & "\Test"
End Sub

'3 删除文件夹

'RmDir语句可以删除一个文件夹，如果想要使用 RmDir 来删除一个含有文件的目录或文件夹，则会发生错误。
'在试图删除目录或文件夹之前，先使用 Kill 语句来删除所有文件。

 Sub w3()
      RmDir ThisWorkbook.path & "\test"
 End Sub

'4 文件夹重命名

  Sub w4()
      Name ThisWorkbook.path & "\test" As ThisWorkbook.path & "\test2"
  End Sub

'5 文件夹移动
'同样使用name方法，可以达到移动的效果，而且连文件夹的文件一起移动

Sub w5()
  Name ThisWorkbook.path & "\test2" As ThisWorkbook.path & "\2011年报表\test100"
End Sub

'6 文件夹复制

   Sub CopyFile_fso()
        Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        fso.CopyFolder ThisWorkbook.path & "\测试新建文件夹", ThisWorkbook.path & "\2011年报表\"
        Set fso = Nothing
    End Sub

'7 打开文件夹
'使用shell函数桌面管理程序打开文件夹

  Sub w7()
      Shell "explorer.exe " & ThisWorkbook.path & "\2011年报表", 1
  End Sub

'遍历指定文件夹中的文件

 Sub 遍历文件()
      Dim Filename As String, mypath As String, k As Integer
      mypath = ThisWorkbook.path & "\2011年报表\1月\A公司\"
      Range("A1:A10") = ""
      Filename = Dir(mypath & "*月*.xls")
      
      Do
	        k = k + 1
	        Cells(k, 1) = Filename
	        Filename = Dir
      Loop Until Filename = ""
      
 End Sub

---

Sub 遍历子文件夹()
      Dim Filename As String, mypath As String, k As Integer
      mypath = ThisWorkbook.path & "\2011年报表\"
      Range("A1:A10") = ""
      Filename = Dir(mypath, vbDirectory)
      
      Do
	        If Not Filename Like "*.*" Then
		          k = k + 1
		          Cells(k, 1) = Filename
	        End If
	        Filename = Dir
      Loop Until Filename = ""
 End Sub

遍历文件

Sub test3()
    Dim wb As Workbook
    Dim i As Long
    Dim t
    Dim arr()
    
        ActiveSheet.UsedRange = ""
        
        With Application.FileSearch '调用fileserch对象
            .NewSearch '开始新的搜索
            .LookIn = ThisWorkbook.path  '设置搜索的路径
            .SearchSubFolders = True '搜索范围包括 LookIn 属性指定的文件夹中的所有子文件夹
            .Filename = "*.xl*" '设置搜索的文件类型
            
            If .Execute() > 0 Then '如果找到文件
             	ReDim arr(1 To .FoundFiles.Count, 1 To 1)
             	
                For i = 1 To .FoundFiles.Count
                    arr(i, 1) = .FoundFiles(i) '把找到的文件放在单元格里
                Next i
                
            Else
                 MsgBox "没找到文件"
            End If
         End With
         
        Range("a1").Resize(i - 1) = arr
 
End Sub