Board logo

標題: [發問] VBA 開起最新文字文件檔 並修改 [打印本頁]
作者: vm3503ru8    時間: 2017-9-5 15:22     標題: VBA 開起最新文字文件檔 並修改

請問 VBA 要如何打開 指定資料夾中 日期最新的文字文件檔
並且修改他

把文字文件檔的
如圖中畫紅色的地方 全部新增一個空白鍵
@@
[attach]27714[/attach]
作者: GBKEE    時間: 2017-9-7 08:17

回復 1# vm3503ru8
是最新存檔的日期時間嗎?
  1. Option Explicit
  2. Sub Ex修改文件檔案()
  3.     Dim F As Object, E, AR(), i As Integer, A As Variant, xFile As String
  4.     'Set F = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files
  5.     Set F = CreateObject("Scripting.FileSystemObject").GetFolder("你的資料夾路徑??").Files
  6.     '.Files ->這資料夾路徑中的所有的檔案
  7.     ReDim AR(1 To 2, 1 To F.Count)
  8.     For Each E In F
  9.         If E Like "*.txt" Then     '檔案副檔名為txt
  10.             i = i + 1
  11.             AR(1, i) = E                        '陣列第一維 置入檔案名稱
  12.             AR(2, i) = CDbl(E.DateLastModified) '陣列第二維 置入存檔的日期時間
  13.         End If
  14.     Next
  15.     A = Application.WorksheetFunction.Index(AR, 2)
  16.     xFile = AR(Application.Match(Application.Max(A), A, 0), 1)  '最新存檔的檔案名稱
  17.     Set F = CreateObject("Scripting.FileSystemObject").OPENTextFile(xFile, 1)   '開啟文件檔,讀取模式
  18.     A = Split(F.readall, vbLf)         '讀取檔案內容
  19.     F.Close                            '關閉文件檔案
  20.     Set F = CreateObject("Scripting.FileSystemObject").CreateTextFile(xFile, True) '開啟文件檔,可覆蓋原文件檔模式
  21.     For i = 0 To UBound(A)
  22.         F.WriteLine IIf(i > 1 And A(i) <> "", Space(1), "") & A(i)
  23.     Next
  24.     F.Close
  25. End Sub
複製代碼
作者: vm3503ru8    時間: 2017-9-7 11:49

謝謝版主 沒錯是最新時間
因為我們做完一件事 他會自動儲存在一格資料夾內
因為我是用錄製巨集來放入 EXCEL 可是我是用空白格來分割
所以需要前面都要有空白@@

版大 可是我錄製後 我匯入TXT檔 跑到  .CommandType = 0
他都說呼叫不正確
作者: vm3503ru8    時間: 2017-9-7 12:00

報告 版主 問題解決@@


但是現在也是遇到一個問題
我要匯入TXT到EXCEL 他也要知道 最新存檔日期的那一個在匯入@@
作者: GBKEE    時間: 2017-9-7 13:56

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

回復 4# vm3503ru8
.CommandType = 0 他都說呼叫不正確
沒看到程式,不了解
  1. Option Explicit
  2. Dim xPath As String
  3. Sub Ex()
  4.     xPath = "d:\" 'ThisWorkbook.Path
  5.     Ex_修改最新文字檔
  6.     Workbooks.Open Latest_file(xPath)  '匯入TXT到EXCEL
  7. End Sub
  8. Sub Ex_修改最新文字檔()
  9.     Dim xFile As String, F As Object,  i As Integer
  10.     Dim My(), myRow As Integer
  11.     xFile = Latest_file(xPath)  'Latest_file函數(Function) ,傳回:最新存檔的檔案名稱
  12.     Open xFile For Input As #1
  13.     Do Until EOF(1)
  14.         ReDim Preserve My(0 To myRow)
  15.         Input #1, My(myRow) ', my(1), my(2), my(3), my(4), my(5), my(6)
  16.         myRow = myRow + 1
  17.     Loop
  18.     Close #1
  19.     Set F = CreateObject("Scripting.FileSystemObject").CreateTextFile(xFile, True) '開啟文件檔,可覆蓋原文件檔模式
  20.     For i = 0 To UBound(My)
  21.     F.Writeline My(i)
  22.     Next
  23.     F.Close
  24. End Sub
  25. Function Latest_file(資料夾路徑 As String) As String    '自訂函數(Function) ,傳回:最新存檔的檔案名稱
  26.     Dim F As Object, E, AR(), i As Integer, A As Variant, xFile As String
  27.     Set F = CreateObject("Scripting.FileSystemObject").GetFolder(資料夾路徑).Files
  28.     ReDim AR(1 To 2, 1 To F.Count)
  29.     For Each E In F
  30.         If E Like "*.txt" Then     '檔案副檔名為txt
  31.             i = i + 1
  32.             AR(1, i) = E                        '陣列第一維 置入檔案名稱
  33.             AR(2, i) = CDbl(E.DateLastModified) '陣列第二維 置入存檔時間
  34.         End If
  35.     Next
  36.     A = Application.WorksheetFunction.Index(AR, 2)
  37.     On Error Resume Next
  38.     Latest_file = AR(Application.Match(Application.Max(A), A, 0), 1)
  39.     If Err Then MsgBox 資料夾路徑 & "資料夾,找不到  txt檔案 !!! ": End
  40. End Function
複製代碼
作者: vm3503ru8    時間: 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

是否有辦法改成 用空白格分割
然後一樣照著 最新日期@@
作者: vm3503ru8    時間: 2017-9-7 14:54

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

不好意思 版大

剛剛6樓意思錯了

是為什麼 如果我把中文放在前面 他就無法分割
數字就可以@@
[attach]27720[/attach]
如圖下一樣@@ 想讓他可以自行分割
[attach]27719[/attach]
[attach]27721[/attach]
作者: vm3503ru8    時間: 2017-9-8 09:32

不好意思版大

遇到新狀況

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

在匯入 現在開啟的這個excel裡面
以空格來分隔
資料格式以文字匯入
在指定的儲存格內
作者: vm3503ru8    時間: 2017-9-8 09:46

抱歉@@

是以tab 跟 空格來分隔
作者: vm3503ru8    時間: 2017-9-8 11:19

這裡 版大請查收
作者: vm3503ru8    時間: 2017-9-9 17:54

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

[attach]27726[/attach]

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
這是自己改的 可能不盡理想-..-
[attach]27725[/attach]
作者: GBKEE    時間: 2017-9-10 08:33

回復 11# vm3503ru8
這裡要改
  1. For i = 0 To UBound(A)
  2.          F.WriteLine A(i)
  3.     Next
複製代碼
作者: vm3503ru8    時間: 2017-9-14 08:13

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



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