遍歷excel文件

最近寫pl/sql，有表定義什麼的，又要用vba作工具
我每次寫都在網上查如何用vba遍歷excel, 很麻煩
今天把以前寫的例子整理下來，省得每次都查
Dim intX As Integer
Dim intYBook As Integer
Dim intYSheet As Integer

Sub CreateLink()

    Dim fs, f, f1, fc, s, file
    Dim TargetFolder As String
   
    intX = 1
    intYBook = 1
    intYSheet = 2
               
    TargetFolder = ThisWorkbook.Path

    ChDir TargetFolder
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(TargetFolder)
    Set fc = f.Files

    Range("A1:C2000").Clear
   
    For Each f1 In fc
        If f1.Name <> ThisWorkbook.Name Then
            If InStr(f1.Name, ".xls") <> 0 Then
                GetAllSheet (f1.Name)
            End If
        End If
    Next

 

End Sub

Sub GetAllSheet(FileName As String)

Cells(intX, intYBook).Value = FileName

intX = intX + 1

    Workbooks.Open ThisWorkbook.Path + "/" + FileName
   
    For i = 1 To Workbooks(FileName).Sheets.Count
       Workbooks(ThisWorkbook.Name).Sheets(1).Cells(intX, intYSheet).Value = Workbooks(FileName).Sheets(i).Name
       Workbooks(ThisWorkbook.Name).Sheets(1).Activate
        Workbooks(ThisWorkbook.Name).Sheets(1).Cells(intX, intYSheet).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=FileName, _
        SubAddress:=Workbooks(FileName).Sheets(i).Name + "!A1"
       intX = intX + 1
    Next
    Workbooks(FileName).Close SaveChanges:=False
   
End Sub