[發問] 請問如何自動匯入外部資料

想請教大家Excel如何自動匯入外部資料的相關問題...
目前每天都會有固定的檔案需要匯入到Excel不同的Sheet
但是每天的檔名都有加上日期，所以檔名會隨著日期改變，
想請問大家如何讓Excel自動匯入這些檔案到指定的Sheet?
例如:

9月17日，我必須將檔名
"F03-MB-1_0916_103051.log"的檔案內容匯入到Excel的"MB-1" sheet
"F03-MB-2_0916_103051.log"的檔案內容匯入到Excel的"MB-2" sheet
"F03-MB-3_0916_103051.log"的檔案內容匯入到Excel的"MB-3" sheet
"F03-MB-4_0916_103051.log"的檔案內容匯入到Excel的"MB-4" sheet
"F03-MB-5_0916_103051.log"的檔案內容匯入到Excel的"MB-5" sheet
"F03-MB-6_0916_103051.log"的檔案內容匯入到Excel的"MB-6" sheet
....總共有50個檔案要匯入到50個sheet (若當天缺少檔案，則該sheet內容為空白)

9月18日，我必須將檔名
"F03-MB-1_0917_103051.log"的檔案內容匯入到Excel的"MB-1" sheet
"F03-MB-2_0917_103051.log"的檔案內容匯入到Excel的"MB-2" sheet
"F03-MB-3_0917_103051.log"的檔案內容匯入到Excel的"MB-3" sheet
"F03-MB-4_0917_103051.log"的檔案內容匯入到Excel的"MB-4" sheet
"F03-MB-5_0917_103051.log"的檔案內容匯入到Excel的"MB-5" sheet
"F03-MB-6_0917_103051.log"的檔案內容匯入到Excel的"MB-6" sheet
....總共有50個檔案要匯入到50個sheet (若當天缺少檔案，則該sheet內容為空白)

0916 SEL.zip (21.95 KB)

樓主熱帖

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2011-10-6 15:29 | 只看該作者

回復 1# sandra_wang
試試看

Sub 匯入文字檔_Ex()
Dim MyPath As String, TheDate As String, TheFile As String, ShName As String, Mystr As String, Rng As Range, E As Variant
MyPath = ThisWorkbook.Path & "\" '文字檔所在的目錄
TheDate = Format(Date - 1, "mm/dd") '取的日期
On Error Resume Next 'DIR 找不到檔案會產生錯誤
TheFile = Dir(MyPath & "*MB-*" & TheDate & "*.log") '尋找檔案
If Err.Number > 0 Then MsgBox "找不到 " & TheDate & " 檔案": Exit Sub
Do While TheFile <> ""
On Error GoTo ShAdd '工作表中沒有 ShName會產生錯誤
ShName = Mid(TheFile, InStr(TheFile, "MB-"), InStr(TheFile, "_") - InStr(TheFile, "MB-"))
Set Rng = Sheets(ShName).Cells(Rows.Count, "A").End(xlUp)
If Rng <> "" Then Set Rng = Rng.Offset(1)
Open MyPath & TheFile For Input As #1 '開啟文字檔
Do While Not EOF(1) '不是檔案底部時執行迴圈
Input #1, Mystr '從已開啟的循序讀取資料，並將資料指定給變數。->mystr
For Each E In Split(Mystr, Chr(10))
Rng = E
Set Rng = Rng.Offset(1)
Next
Loop
Close #1 '關閉文字檔
TheFile = Dir
Loop
Exit Sub
ShAdd:
ThisWorkbook.Sheets.Add.Name = ShName
Err.Clear
Resume
End Sub