[發問] VBA 開起最新文字文件檔 並修改

帖子: 14
主題: 3
精華: 0
積分: 17
點名: 0
作業系統: windows
軟體版本: 2013
閱讀權限: 10
註冊時間: 2017-4-30
最後登錄: 2019-11-23

13^#

發表於 2017-9-14 08:13 | 只看該作者

超感謝版大已經可以使用^^

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兔年全勤獎章

12^#

發表於 2017-9-10 08:33 | 只看該作者

回復 11# vm3503ru8
這裡要改

For i = 0 To UBound(A)
F.WriteLine A(i)
Next

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 14
主題: 3
精華: 0
積分: 17
點名: 0
作業系統: windows
軟體版本: 2013
閱讀權限: 10
註冊時間: 2017-4-30
最後登錄: 2019-11-23

11^#

發表於 2017-9-9 17:54 | 只看該作者

不好意思版大
我文字文件檔的內容不定一樣@@
跑到這裡都會錯誤
裡面嘗試起來第二樓的語法比較是理想的@@
但是要把第一行有空白格拿掉
再帶入EXCEL裡面

Option Explicit
Dim xPath As String

Sub Ex()
xPath = "d:\" 'ThisWorkbook.Path
Ex_修改最新文字檔
Workbooks.Open Latest_file(xPath)  '匯入TXT到EXCEL
End Sub
Sub Ex修改文件檔案()
Dim F As Object, E, AR(), i As Integer, A As Variant, xFile As String
   Dim My() As Integer
'Set F = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files
Set F = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\USER\Desktop\data").Files
'.Files ->這資料夾路徑中的所有的檔案
ReDim AR(1 To 2, 1 To F.Count)
For Each E In F
      If E Like "*.mea" Then    '檔案副檔名為txt
         i = i + 1
         AR(1, i) = E                      '陣列第一維置入檔案名稱
         AR(2, i) = CDbl(E.DateLastModified) '陣列第二維置入存檔的日期時間
      End If
Next
A = Application.WorksheetFunction.Index(AR, 2)
xFile = AR(Application.Match(Application.Max(A), A, 0), 1)  '最新存檔的檔案名稱
Set F = CreateObject("Scripting.FileSystemObject").OpenTextFile(xFile, 1) '開啟文件檔,讀取模式
A = Split(F.ReadAll, vbLf)       '讀取檔案內容
F.Close                         '關閉文件檔案
Set F = CreateObject("Scripting.FileSystemObject").CreateTextFile(xFile, True) '開啟文件檔,可覆蓋原文件檔模式
For i = 0 To UBound(A)
      F.WriteLine (i)
Next
F.Close

End Sub
這是自己改的可能不盡理想-..-

data.rar (57.5 KB)

帖子: 14
主題: 3
精華: 0
積分: 17
點名: 0
作業系統: windows
軟體版本: 2013
閱讀權限: 10
註冊時間: 2017-4-30
最後登錄: 2019-11-23

10^#

發表於 2017-9-8 11:19 | 只看該作者

[版主管理留言]

GBKEE(2017/9/9 09:40): 第5帖程式碼已更新,請參考看看

這裡版大請查收

text.rar (537 Bytes)

帖子: 14
主題: 3
精華: 0
積分: 17
點名: 0
作業系統: windows
軟體版本: 2013
閱讀權限: 10
註冊時間: 2017-4-30
最後登錄: 2019-11-23

9^#

發表於 2017-9-8 09:46 | 只看該作者

[版主管理留言]

GBKEE(2017/9/8 11:15): 請附上文字檔的看看

抱歉@@

是以tab 跟空格來分隔

帖子: 14
主題: 3
精華: 0
積分: 17
點名: 0
作業系統: windows
軟體版本: 2013
閱讀權限: 10
註冊時間: 2017-4-30
最後登錄: 2019-11-23

8^#

發表於 2017-9-8 09:32 | 只看該作者

不好意思版大

遇到新狀況

要開啟單一資料夾裡面日期最新的 txt檔
並且把圖中紅色區域的地方不要有空白格

在匯入現在開啟的這個excel裡面
以空格來分隔
資料格式以文字匯入
在指定的儲存格內

帖子: 14
主題: 3
精華: 0
積分: 17
點名: 0
作業系統: windows
軟體版本: 2013
閱讀權限: 10
註冊時間: 2017-4-30
最後登錄: 2019-11-23

7^#

發表於 2017-9-7 14:54 | 只看該作者

本帖最後由 vm3503ru8 於 2017-9-7 14:56 編輯

不好意思版大

剛剛6樓意思錯了

是為什麼如果我把中文放在前面他就無法分割
數字就可以@@

如圖下一樣@@ 想讓他可以自行分割

帖子: 14
主題: 3
精華: 0
積分: 17
點名: 0
作業系統: windows
軟體版本: 2013
閱讀權限: 10
註冊時間: 2017-4-30
最後登錄: 2019-11-23

6^#

發表於 2017-9-7 14:05 | 只看該作者

請問版大@@
Sub OP()
Dim myDir As String, myRow As Integer
Dim my(6)
myDir = ThisWorkbook.Path & "\"
myRow = 15
Open myDir & "123.TXT" For Input As #1
Do Until EOF(1)
Input #1, my(0), my(1), my(2), my(3), my(4), my(5), my(6)

Cells(myRow, 1).Value = my(0)
Cells(myRow, 2).Value = my(1)
Cells(myRow, 3).Value = my(2)
Cells(myRow, 4).Value = my(3)
Cells(myRow, 5).Value = my(4)
Cells(myRow, 6).Value = my(5)
Cells(myRow, 7).Value = my(6)

myRow = myRow + 1

Loop
Close #1

End Sub

是否有辦法改成用空白格分割
然後一樣照著最新日期@@

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兔年全勤獎章

5^#

發表於 2017-9-7 13:56 | 只看該作者

本帖最後由 GBKEE 於 2017-9-9 09:33 編輯

回復 4# vm3503ru8
.CommandType = 0 他都說呼叫不正確
沒看到程式,不了解

Option Explicit
Dim xPath As String
Sub Ex()
xPath = "d:\" 'ThisWorkbook.Path
Ex_修改最新文字檔
Workbooks.Open Latest_file(xPath) '匯入TXT到EXCEL
End Sub
Sub Ex_修改最新文字檔()
Dim xFile As String, F As Object, i As Integer
Dim My(), myRow As Integer
xFile = Latest_file(xPath) 'Latest_file函數(Function) ,傳回:最新存檔的檔案名稱
Open xFile For Input As #1
Do Until EOF(1)
ReDim Preserve My(0 To myRow)
Input #1, My(myRow) ', my(1), my(2), my(3), my(4), my(5), my(6)
myRow = myRow + 1
Loop
Close #1
Set F = CreateObject("Scripting.FileSystemObject").CreateTextFile(xFile, True) '開啟文件檔,可覆蓋原文件檔模式
For i = 0 To UBound(My)
F.Writeline My(i)
Next
F.Close
End Sub
Function Latest_file(資料夾路徑 As String) As String '自訂函數(Function) ,傳回:最新存檔的檔案名稱
Dim F As Object, E, AR(), i As Integer, A As Variant, xFile As String
Set F = CreateObject("Scripting.FileSystemObject").GetFolder(資料夾路徑).Files
ReDim AR(1 To 2, 1 To F.Count)
For Each E In F
If E Like "*.txt" Then '檔案副檔名為txt
i = i + 1
AR(1, i) = E '陣列第一維置入檔案名稱
AR(2, i) = CDbl(E.DateLastModified) '陣列第二維置入存檔時間
End If
Next
A = Application.WorksheetFunction.Index(AR, 2)
On Error Resume Next
Latest_file = AR(Application.Match(Application.Max(A), A, 0), 1)
If Err Then MsgBox 資料夾路徑 & "資料夾,找不到 txt檔案 !!! ": End
End Function

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.