- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# morris0914
試試看- Sub Ex()
- Dim FilePath As String, Rng As Range, FS As Object, Ar
- FilePath = Sheets("Menu").Range("B1") '檔案資料夾"
- FilePath = FilePath & IIf(Right(1, 1) = "\", "", "\") '檢查資料夾尾端有無"\"
- Set Rng = Sheets("Menu").Range("D9") '第1個檔案名稱
- Do
- Set FS = CreateObject("Scripting.FileSystemObject").GetFile(FilePath & Rng) '取的檔案物件
- 'FileSystemObject 提供對電腦檔案系統的存取的物件
- Set FS = FS.OpenAsTextStream(1, -2) 'TextStream 物件->加快對檔案的順序存取。
- Ar = Split(FS.READALL, Chr(10)) '讀取資料存入陣列 Ar
- FS.Close ' 將檔案關閉。
- With ActiveWorkbook '作用中的活頁簿
- .Sheets.Add(, .Sheets(.Sheets.Count)).Name = Rng '新增工作表且命名為檔案名稱
- .Sheets(Rng.Value).[A1].Resize(UBound(Ar) + 1, 1) = Ar '讀取的資料放入新增工作表
- End With
- Set Rng = Rng.Offset(1) '下一個檔案名稱
- Loop Until Rng = "" '沒有檔案名稱 離開迴圈
- End Sub
|
|
發表於 2011-7-27 20:38
| 
