[發問] 搜尋某資料夾中檔案的數量，每增加一筆資料就收錄進來

帖子: 15
主題: 3
精華: 0
積分: 59
點名: 0
作業系統: windows xp
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-1-17
最後登錄: 2014-3-26

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2012-7-18 17:49 | 只看該作者

[發問] 搜尋某資料夾中檔案的數量，每增加一筆資料就收錄進來

某個軟體每秒在"D:\raw data\"資料夾中儲存一個Excel檔案
檔案名稱依序從 ResultsFile1、ResultsFile2、ResultsFile3、....、ResultsFile10、ResultsFile11、...
我想要建一個"Record.xls" 叫他自動偵測這個資料夾是否有新的Excel檔進來
每當有新檔案就把他打開存取Cells(2,3)的值進入"Record.xls" 中
請問該如何寫VBA叫他自動偵測?
感謝

樓主熱帖

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 259
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-30

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2012-7-19 00:00 | 只看該作者

本帖最後由 Hsieh 於 2012-7-20 09:20 編輯

回復 1# sweetkitty
或許還有其他辦法(如開通DDE通道)
比較不花腦筋的作法
利用ONTIME方法，每秒去跑資料夾內的檔案名稱
然後記錄在A、B欄內，就能判斷是否有新增檔案
一般模組

Sub auto_open()
fd = "D:\raw data\" '資料夾
fs = Dir(fd & "*.xls")
Set sht = ThisWorkbook.Sheets(1)
Do Until fs = ""
If IsError(Application.Match(fs, sht.Columns("A"), 0)) Then
With Workbooks.Open(fd & fs)
sht.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2) = Array(fs, .Sheets(1).Cells(2, 3).Value)
.Close 0
End With
End If
fs = Dir
Loop
Application.OnTime Now + TimeValue("00:00:01"), "auto_open"
End Sub

複製代碼

學海無涯_不恥下問

hugh0620

　暱稱: VBA向前衝

高中生 Rank: 3 Rank: 3

帖子: 559
主題: 58
精華: 0
積分: 626
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-6-14

3^#

發表於 2012-7-19 10:42 | 只看該作者

回復 2# Hsieh

H大大~ 這樣的方式~
不是也一定要打開excel才能夠自動去搜尋嘛??

學習才能提升自己

帖子: 15
主題: 3
精華: 0
積分: 59
點名: 0
作業系統: windows xp
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-1-17
最後登錄: 2014-3-26

4^#

發表於 2012-7-19 15:53 | 只看該作者

回復 2# Hsieh
感謝H大回答，不過我執行的時候出現"無法執行巨集"的視窗
Loop之前的動作都執行完畢了，是最後一行Application沒辦法做
請問有什麼我沒注意的地方嗎?
謝謝!!

auto open.JPG (22.7 KB)

帖子: 15
主題: 3
精華: 0
積分: 59
點名: 0
作業系統: windows xp
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-1-17
最後登錄: 2014-3-26

5^#

發表於 2012-7-24 16:22 | 只看該作者

本帖最後由 sweetkitty 於 2012-7-24 17:15 編輯

回復 2# Hsieh

感謝H大大! 我發現把程式碼放在"模組"裡面就可以執行了
另外我修改成我要的樣子，發現您原來的程式碼跑會自動抓"有新增的檔案"取值
但我的程式碼會一直不斷的從第一個檔案開始repeat
請問是哪個程式碼沒改到呢?
感謝

Sub 自動整理資料()
fd = "D:\Wayne\" '資料夾
fs = Dir(fd & "ResultsFile*")
Set sht = ThisWorkbook.Sheets(2)
Do Until fs = ""
If IsError(Application.Match(fs, sht.Columns("A"), 0)) Then
With Workbooks.Open(fd & fs)
sht.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Mid(Workbooks(fs).Name, 12)
sht.Cells(Rows.Count, j * 2).End(xlUp).Offset(1) = Workbooks(fs).Sheets(1).Cells(23, j * 2 + 1).Value
.Close 0
End With
End If
fs = Dir
Loop
Application.OnTime Now + TimeValue("00:00:01"), "自動整理資料"
End Sub

複製代碼

帖子: 15
主題: 3
精華: 0
積分: 59
點名: 0
作業系統: windows xp
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-1-17
最後登錄: 2014-3-26

6^#

發表於 2012-7-24 17:17 | 只看該作者

回復 5# sweetkitty

我發現把上面那個程式碼的第9行改成以下這樣，就不會發生重複填入資料的狀況了

sht.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2) = Array(fs, .Sheets(1).Cells(2, 3).Value)

複製代碼

但是我還是不太明白原理，希望可以解惑
感謝