[發問] VBA 開啟檔案應用

Jason80Lo

請教各位前輩

某固定資料夾中每分鐘會不固定增加.TXT檔，且檔案名稱不同 但基本上檔案名稱長度是一樣的
小弟目前只能使用Timer物件開啟固定路徑的.TXT，如何使用VBA 開啟這5分鐘內資料夾所有產生的.TXT檔
依時間將資料產生的順序分別顯示A1、B1、C1
EX：C:\Users\j\Desktop\test   資料夾中
     此次五分鐘內依序產生 >  111.txt   222.txt   333.txt
                              檔案內容>     1               2           3

                      儲存格顯示為>     A1           B1        C1
                                                       1               2           3
  

請各位前輩幫幫小弟，謝謝

准提部林

回復 1# Jason80Lo


能否上傳部份文字檔及excel主檔，並手動模擬需求結果？

基本要求：
尋求VBA解決問題，上傳檔案才可正確判讀資料結構及決定方法！

Jason80Lo

回復 2# 准提部林

需求：Test資料夾在某5分鐘內Server丟出產生 111.txt , 222.txt, 333.txt ，小弟需求為將這5分鐘內產生的txt檔，自動開啟，
也就是說每5分鐘 程式能夠自動去Check  Test資料夾是否有新的txt檔(小弟目前只能使用Timer物件開啟固定路徑的.TXT)，但無法一次開啟這麼多txt檔 且名稱都不一樣。

    Test.rar (8.43 KB)

需求結果
下載次數: 8

2015-9-28 18:02

准提部林

程式碼請自行去套，在工作表１建兩個按鈕，分別指定〔開始〕及〔停止〕，
〔停止〕鈕用來暫停程式，關閉檔案前也必須按〔停止〕再關！
uP = ThisWorkbook.Path & "\"　是文字檔資料夾的〔路徑〕，請自行更改實際路徑！

程式碼初看頗複雜，恕無法一一說明，有必要可搜一下論壇資料去漸進理解！
　

1. Public uMode&, uBook As Workbook, uSht As Worksheet, uDic As Object
   
2. '======================================================
   
3. 　
   
4. Sub 開始()
   
5. Dim FN, xE As Range
   
6. If uMode = 1 Then Exit Sub
   
7. Set uBook = ThisWorkbook
   
8. Set uSht = uBook.Sheets("工作表1")
   
9. Set uDic = CreateObject("Scripting.Dictionary")
   
10. Set xE = uSht.Cells(1, Columns.Count).End(xlToLeft)
    
11. For Each FN In Range(uSht.[B1], xE).Value
    
12. 　　If FN Like "*.txt" Then uDic(FN) = 1
    
13. Next
    
14. uMode = 1
    
15. Call 監視
    
16. End Sub
    
17. 　
    
18. '======================================================
    
19. Sub 停止()
    
20. uMode = 0
    
21. Set uDic = Nothing
    
22. End Sub
    
23. 　
    
24. '======================================================
    
25. Sub 監視()
    
26. Dim uP$, xE As Range, TM, FL$, TT
    
27. If uMode = 0 Then Exit Sub
    
28. TM = Time
    
29. uSht.[A5] = Format(TM, "hh:mm:ss")
    
30. If Second(TM) = 0 And Minute(TM) Mod 5 = 0 Then　'這是每５分鐘
    
31. 'If Second(TM) Mod 5 = 0 Then　'這是每５秒
    
32. 　　uP = ThisWorkbook.Path & "\"
    
33. 　　Set xE = uSht.Cells(1, Columns.Count).End(xlToLeft)(1, 2)
    
34. 　　Do
    
35. 　　　　If FL = "" Then FL = Dir(uP & "*.txt") Else FL = Dir
    
36. 　　　　If FL = "" Then Exit Do
    
37. 　　　　If uDic(FL) = "" Then
    
38. 　　　　　xE = FL:   uDic(FL) = 1
    
39. 　　　　　Open uP & FL For Input Access Read As #1
    
40. 　　　　　　Line Input #1, TT
    
41. 　　　　　　xE(3, 1) = TT
    
42. 　　　　　Close #1
    
43. 　　　　　Set xE = xE(1, 2)
    
44. 　　　　End If
    
45. 　　Loop
    
46. 　　uBook.Save
    
47. End If
    
48. Application.OnTime Now + TimeValue("00:00:01"), "監視"
    
49. End Sub

複製代碼

　

GBKEE

回復 3# Jason80Lo
參考一下
同一個[一般模組]的程式碼

1. Option Explicit
   
2. Dim Msg As Boolean, xTime As Variant
   
3. '一般模組:檔案開啟時自動執行的程序
   
4. Sub AUTO_OPEN()  '兩個按鈕〔開始〕
   
5.     If Msg = True Then Exit Sub
   
6.     Msg = True
   
7.     Ex
   
8. End Sub
   
9. '一般模組:檔案關閉時自動執行的程序
   
10. Sub AUTO_CLOSE() '兩個按鈕，[ 停止〕
    
11.      Msg = False
    
12.      If xTime <> "" Then
    
13.         Application.OnTime xTime, "Ex", Schedule:=False  '關閉下一個OnTime的執行
    
14.         '這檔案關閉後,Excel沒關閉還是會執行OnTime的程式,會再度開啟這檔案
    
15.         xTime = ""
    
16.      End If
    
17.      ActiveWorkbook.Save  '使用中活頁簿存檔
    
18. End Sub
    
19. Private Sub Ex()
    
20.     Dim xPath As String, Rng(1 To 2) As Range, xFile As String, i As Integer
    
21.     Dim xString
    
22.     xPath = "d:\test\"  'txt 檔案的目錄
    
23.     Set Rng(1) = ActiveWorkbook.Sheets("Sheet1").Rows(1)  ''使用中活頁簿,這工作表的第一列
    
24.     xFile = Dir(xPath & "\*.txt")          '搜尋附檔名
    
25.     Do While xFile <> ""                   '找到
    
26.         Set Rng(2) = Rng(1).Find(xFile, LookAT:=xlWhole) '比對第一列中的 txt檔
    
27.         If Rng(2) Is Nothing Then                        '第一列中比對沒有這txt檔
    
28.             i = 1
    
29.            With Rng(1).Cells(Application.CountA(Rng(1)) + 1) '依序在第一列中
    
30.                 .Cells = xFile                  '檔名寫入儲存格中
    
31.                 Open xPath & xFile For Input Access Read As #1  '開啟文字檔
    
32.                 Do Until EOF(1)                 '執行迴圈直到檔尾為止。
    
33.                     Line Input #1, xString      '將資料讀入變數中。
    
34.                     .Cells(3 + i, 1) = xString  '變數寫入儲存格中
    
35.                     i = i + 1
    
36.                 Loop
    
37.                 Close #1    ' 關閉檔案。
    
38.             End With
    
39.         End If
    
40.         xFile = Dir         '查下一個 txt檔
    
41.     Loop
    
42.     xTime = Int(Application.Text(Time, "[m]") / 5) + 1  '現在時間的分鐘數/5  的整數+ 1
    
43.     xTime = DateAdd("N", 5 * xTime, 0)                  '下一個5分整
    
44.     Application.OnTime xTime, "Ex"
    
45.     Application.StatusBar = "下次執行時間 " & xTime
    
46. End Sub

複製代碼

准提部林

回復 5# GBKEE


Application.OnTime xTime, "Ex", Schedule:=False  '關閉下一個OnTime的執行　

還是超版的程式〔有料〕～～　

Jason80Lo

感謝兩位版主 回覆 小弟套套看

Jason80Lo

回復 5# GBKEE

超級版主你好，程式碼中 Open xPath & xFile For Input Access Read As #1  '開啟文字檔 出現錯誤碼53 找不到檔案 ，
程式碼中xPath為資料夾路徑 xFile為找到的.txt檔 檔案路徑都為正確，但還是無法順利開啟，請問是有哪邊出問題？
   

下載 (8.74 KB)

2015-9-29 23:34

GBKEE

回復 8# Jason80Lo
d:\test\

   

1. xPath = "d:\test\"  'txt 檔案的目錄

複製代碼

1. MsgBox xPath & xFile '看看
   
2. Open xPath & xFile For Input Access Read As #1  

複製代碼

Jason80Lo

回復 9# GBKEE

謝版大
另外我想請問下方程式碼
為何 xTime = Int(Application.Text(Time, "[m]") / 5) + 1 '現在時間的分鐘數/5  的整數+ 1  都需要將時間/5後面還要+1 ？
另外xTime = DateAdd("N", 5 * xTime, 0)  我想要更改程式碼裡面"5" 程式就會當掉，如果要每30秒、30分、3小時更新可以嗎 ？