麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] VBA 開啟檔案應用 [打印本頁]

作者: Jason80Lo 時間: 2015-9-24 23:05 標題: VBA 開啟檔案應用

請教各位前輩

某固定資料夾中每分鐘會不固定增加.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


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

作者: 准提部林 時間: 2015-9-25 11:05

回復 1# Jason80Lo

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

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

作者: Jason80Lo 時間: 2015-9-28 18:02

回復 2# 准提部林

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

[attach]22108[/attach]

作者: 准提部林 時間: 2015-9-28 20:50

本帖最後由准提部林於 2015-9-28 20:53 編輯

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

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

Public uMode&, uBook As Workbook, uSht As Worksheet, uDic As Object
'======================================================
　
Sub 開始()
Dim FN, xE As Range
If uMode = 1 Then Exit Sub
Set uBook = ThisWorkbook
Set uSht = uBook.Sheets("工作表1")
Set uDic = CreateObject("Scripting.Dictionary")
Set xE = uSht.Cells(1, Columns.Count).End(xlToLeft)
For Each FN In Range(uSht.[B1], xE).Value
　　If FN Like "*.txt" Then uDic(FN) = 1
Next
uMode = 1
Call 監視
End Sub
　
'======================================================
Sub 停止()
uMode = 0
Set uDic = Nothing
End Sub
　
'======================================================
Sub 監視()
Dim uP$, xE As Range, TM, FL$, TT
If uMode = 0 Then Exit Sub
TM = Time
uSht.[A5] = Format(TM, "hh:mm:ss")
If Second(TM) = 0 And Minute(TM) Mod 5 = 0 Then　'這是每５分鐘
'If Second(TM) Mod 5 = 0 Then　'這是每５秒
　　uP = ThisWorkbook.Path & "\"
　　Set xE = uSht.Cells(1, Columns.Count).End(xlToLeft)(1, 2)
　　Do
　　　　If FL = "" Then FL = Dir(uP & "*.txt") Else FL = Dir
　　　　If FL = "" Then Exit Do
　　　　If uDic(FL) = "" Then
　　　　　xE = FL: uDic(FL) = 1
　　　　　Open uP & FL For Input Access Read As #1
　　　　　　Line Input #1, TT
　　　　　　xE(3, 1) = TT
　　　　　Close #1
　　　　　Set xE = xE(1, 2)
　　　　End If
　　Loop
　　uBook.Save
End If
Application.OnTime Now + TimeValue("00:00:01"), "監視"
End Sub

複製代碼

作者: GBKEE 時間: 2015-9-29 07:17

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

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

複製代碼

作者: 准提部林 時間: 2015-9-29 10:39

回復 5# GBKEE

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

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

作者: Jason80Lo 時間: 2015-9-29 19:06

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

作者: Jason80Lo 時間: 2015-9-29 23:35

回復 5# GBKEE

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

[attach]22116[/attach]

作者: GBKEE 時間: 2015-9-30 16:15

回復 8# Jason80Lo
d:\test\

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

複製代碼

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

複製代碼

作者: Jason80Lo 時間: 2015-9-30 18:28

回復 9# GBKEE

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

作者: GBKEE 時間: 2015-10-1 14:16

回復 10# Jason80Lo
試看看

Option Explicit
Sub Ex()
Dim xTime As Variant
Application.VBE.Windows("即時運算").Visible = True
'30秒、30分、3小時
xTime = Int(Application.Text(Time, "[s]") / 30) + 1
xTime = DateAdd("s", 30 * xTime, 0)
Debug.Print "下一個30秒整", Time, xTime
xTime = Int(Application.Text(Time, "[m]") / 30) + 1
xTime = DateAdd("N", 30 * xTime, 0)
Debug.Print "下一個30分整", Time, xTime
xTime = Int(Application.Text(Time, "[h]") / 3) + 1
xTime = DateAdd("h", 3 * xTime, 0)
Debug.Print "下一個3小時整", Time, xTime
End Sub

複製代碼

作者: no3-taco 時間: 2015-10-1 19:53

本帖最後由 no3-taco 於 2015-10-1 20:03 編輯

回復 11# GBKEE

請問版大，加 Int() 的用意為何，因為第一次執行會有時間上的誤差

xTime = Int(Application.Text(Time, "[m]") / 3) + 1
xTime = DateAdd("N", 3 * xTime, 0)

作者: GBKEE 時間: 2015-10-2 16:45

回復 12# no3-taco

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

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

複製代碼

作者: Jason80Lo 時間: 2015-10-4 10:43

回復 13# GBKEE

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

[attach]22152[/attach]

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

作者: Jason80Lo 時間: 2015-10-4 14:10 標題: VBA 開啟檔案應用2

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

作者: GBKEE 時間: 2015-10-4 14:30

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

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

複製代碼

作者: Jason80Lo 時間: 2015-10-4 14:40

回復 15# GBKEE

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

作者: GBKEE 時間: 2015-10-4 16:22

回復 17# Jason80Lo

試試看

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

複製代碼

作者: Jason80Lo 時間: 2015-10-4 23:15

回復 18# GBKEE

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

作者: Jason80Lo 時間: 2015-10-5 01:06

回復 18# GBKEE

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

作者: Jason80Lo 時間: 2015-10-7 00:04

回復 18# GBKEE

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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)