- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2012-2-23 14:23
| 只看該作者
回復 1# enoch
試試看- Option Explicit
- Sub Ex()
- Dim xlPath As String, Rng As Range, xF As String, Sh As Worksheet
- xlPath = "C:\temp\" '指定資料夾
- xF = Dir(xlPath & "*.CSV")
- 'Dir 函數 傳回一個 String ，用以表示合乎條件、檔案屬性、磁碟標記的一個檔案名稱、或目錄、檔案夾名稱。
- If xF = "" Then MsgBox xlPath & " 沒有CSV 檔案": Exit Sub
- Application.ScreenUpdating = False
- Set Rng = Workbooks.Add(1).Sheets(1).[a1] '新開檔案第1個工作表的[A1]的儲存格
- Do
- With Workbooks.Open(xlPath & xF) '開啟 Dir 傳回的 String(在此為檔案名稱)
- If Rng.Row > 1 Then Set Rng = Rng.Offset(1) '儲存格不是[A1]下移一列
- .Sheets(1).UsedRange.Copy Rng 'CSV檔的內容 複製到 Rng
- Set Rng = Rng.End(xlDown) '複製後 Rng往下移到資料底端
- .Close SaveChanges:=False '關閉CSV檔 不存檔
- End With
- xF = Dir '繼續尋找 CSV檔
- Loop Until xF = "" '離開Do 迴圈的條件是 繼續尋找不到 CSV檔
- Application.ScreenUpdating = True
- MsgBox xlPath & " CSV 檔案 複製 完成"
- Set Sh = Rng.Parent
- Sh.Parent.SaveAs xlPath & "TEST.XLS" '''''存檔
- End Sub
|
|
發表於 2012-2-23 12:11
| 
