[發問] 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
  

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

Jason80Lo

回復 18# GBKEE

版大，小弟的問題已處理好，謝謝

Jason80Lo

回復 18# GBKEE


    請問版大，我路徑資料夾更改後一直跳出錯誤9 陣列索引超出範圍 ，AR()陣列一直顯示前.TXT檔，如下附件圖檔

下載 (166.12 KB)

2015-10-5 01:06

Jason80Lo

回復 18# GBKEE


    謝謝版大 版大英明，小弟好好去研究一番~

GBKEE

回復 17# Jason80Lo

試試看

1. Option Explicit
   
2. Private Sub EX()
   
3.     Dim xPath As String, Rng(1 To 2) As Range, xFile As String, a As Variant, r As String
   
4.     Dim i As Boolean, f As Integer, xString, xMatch As Variant
   
5.     Dim S As Worksheet, AR(), x_Row As Integer
   
6.    
   
7.     If Join(AR, "") = "" Then ReDim AR(0)   '為空陣列,陣列宣告為一元素
   
8.     If IsArray([xFile_Add]) Then AR = [xFile_Add]  '當活頁簿的名稱是陣列
   
9.     ' [xFile_Add] -> [這活頁簿的名稱或函數]
   
10.     Set S = ActiveWorkbook.ActiveSheet
    
11.     Set Rng(1) = S.Rows(1)                          '使用中活頁簿,這工作表的第一列
    
12.     xPath = "C:\Users\j\Desktop\新增資料夾 (4)\"    'txt 檔案的目錄
    
13.     xFile = Dir(xPath & "*.txt")                    '搜尋附檔名
    
14.     Do While xFile <> ""                            '找到
    
15.         xMatch = Application.Match(xFile, AR, 0)    '陣列中搜尋
    
16.         If IsError(xMatch) Then                     '陣列中搜尋沒有這txt檔
    
17.             If Join(AR, "") = "" Then
    
18.                 AR(0) = xFile                       '陣列第一元素=xFile
    
19.             Else
    
20.                 ReDim Preserve AR(0 To UBound(AR) + 1) '陣列上限元素+1
    
21.                 AR(UBound(AR)) = xFile
    
22.             End If
    
23.             Set Rng(2) = Rng(1).Cells(Application.CountA(Rng(1)) + 1) '依序在第一列中
    
24.             i = True
    
25.             Rng(2).Cells = xFile                    '檔名寫入儲存格中
    
26.             f = FreeFile
    
27.             Open xPath & xFile For Input Access Read As #1  '開啟文字檔
    
28.                 Do Until EOF(1)                     '執行迴圈直到檔尾為止。
    
29.                     Line Input #1, xString          '將資料讀入變數中。
    
30.                     a = Split(xString, Space(1))    '該檔案以,為分隔符號
    
31.                     'Split 的型態Variant
    
32.                     If i Then
    
33.                         Rng(2).Cells(2, 1).Resize(UBound(a) + 1) = Application.Transpose(a)
    
34.                         i = 0
    
35.                     Else
    
36.                         With Rng(2).End(xlDown).Offset(1)
    
37.                             .Resize(UBound(a) + 1) = Application.Transpose(a)
    
38.                         End With
    
39.                     End If
    
40.                 Loop
    
41.                 Close #f    ' 關閉檔案。
    
42.         End If
    
43.         xFile = Dir         '查下一個 txt檔
    
44.     Loop
    
45.     If Join(AR, "") <> "" Then ThisWorkbook.Names.Add "xFile_Add", AR    '這活頁簿的名稱 內容為這陣列,
    
46. End Sub

複製代碼

Jason80Lo

回復 15# GBKEE


    版大，不好意思 小弟的意思是因為下一次搜尋到的TXT檔 不要將上次搜尋到的TXT顯示在EXCEL上，因為小弟會將原本sheet1的資料全部刪除

GBKEE

回復 14# Jason80Lo
    5樓的程式碼有防止搜尋到前次搜尋過TXT檔的判斷式.

1.   xFile = Dir(xPath & "\*.txt")          '搜尋附檔名
   
2. Do While xFile <> ""                   '找到
   
3.     Set Rng(2) = Rng(1).Find(xFile, LookAT:=xlWhole) '比對第一列中的 txt檔
   
4.      '***************************************************
   
5.      If Rng(2) Is Nothing Then                        '第一列中比對沒有這txt檔
   
6.      '************這判斷式不是嗎***
   
7.           i = 1

複製代碼

Jason80Lo

請問各位高手 小弟原VBA程式碼功能為將資料夾的TXT檔都開啟
但TXT檔如果要資料分割 結果如附件 txt檔每行遇到"空格"顯示在下方儲存格
但還是無法完成一直出現錯誤，請教各位高手幫忙 Please~:Q
VBA需求結果.rar (17.07 KB)

下載次數: 3

2015-10-4 14:07

Jason80Lo

回復 13# GBKEE


    請問版大，開啟txt檔這個功能目前每搜尋一次都是在固定資料夾重新收尋全部的TXT檔，是否可以在搜尋TXT檔時不會搜尋到前次搜尋過的TXT檔
    說明為如下附件

新增資料夾 (4).rar (7.63 KB)

下載次數: 2

2015-10-4 10:39

請版大看看，是不是有類似辦法幫小弟解決，謝謝

GBKEE

回復 12# no3-taco

INT 的用途是找出,分鐘數被3整除的整數

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim xTime As Variant, nTime As Date
   
4.     Application.VBE.Windows("即時運算").Visible = True
   
5.         nTime = Time
   
6.     xTime = Int(Application.Text(nTime, "[m]") / 3) + 1
   
7.     xTime = DateAdd("N", 3 * xTime, 0)
   
8.     Debug.Print nTime, "第一個3分整", xTime; "", vbLf
   
9.     nTime = xTime
   
10.     xTime = Int(Application.Text(xTime, "[m]") / 3) + 1
    
11.     xTime = DateAdd("N", 3 * xTime, 0)
    
12.     Debug.Print nTime, "再下個3分整", xTime, vbLf
    
13.     Debug.Print "你是要間隔3分鐘後的時間如下"
    
14.     nTime = Time + #12:03:00 AM#
    
15.     Debug.Print Time, "間隔3分鐘後", nTime
    
16.    
    
17. End Sub

複製代碼