[發問] VBA程式開啟一個相同檔名不同檔案

本帖最後由癡肥羔羊於 2022-4-13 14:12 編輯

抱歉想詢問各位:
如何可以先開啟一個相同檔名不同檔案，將資料處理後另存一個新檔案，之後進行輪迴。
目前已有成功開啟，但他會按照資料夾裡面的片數全數開啟

以下是我的vba程式:
Sub A開啟檔案()

Dim lrow As Long
Dim mFile As String
Dim Filename As String

mFile = Dir(ThisWorkbook.Path & "\csv檔\" & "*.csv")
Do While mFile <> ""
Workbooks.Open Filename:=ThisWorkbook.Path & "\csv檔\" & mFile
mFile = Dir()

mFile = Dir(ThisWorkbook.Path & "\TXT檔\" & "*.txt")
Do While mFile <> ""
Workbooks.Open Filename:=ThisWorkbook.Path & "\TXT檔\" & mFile
mFile = Dir()
Loop
Loop

End Sub
再麻煩幫我確認及修改...謝謝~~

1.jpg (34.97 KB)

檔案入徑

2.jpg (13.43 KB)

3.png (13.6 KB)

4.jpg (103.99 KB)

癡肥羔羊

小學生 Rank: 1

帖子: 6
主題: 1
精華: 0
積分: 7
點名: 0
作業系統: Win 10
軟體版本: Office 2016
閱讀權限: 10
性別: 男
註冊時間: 2022-4-13
最後登錄: 2022-5-25

2^#

發表於 2022-4-14 08:36 | 顯示全部帖子

回復 2# samwang

不好意思說明的不清楚，目前是想開兩個相同檔案但不同副檔名CSV與TXT，然後再將TXT裡面的資料複製在CSV檔，然後另存檔案在進行輪迴。
目前資料處理到另存檔案已處理好，但卡在第一關開啟檔案的部分，原因是當資料夾裡有第二個excel檔以上時會同時一起開下去

以下是所有的程式碼:
Sub A開啟SPI_TXT()

Dim lrow As Long
Dim mFile As String
Dim Filename As String

If Len(Dir(ThisWorkbook.Path & "\TEST", vbDirectory)) = 0 Then
MkDir ThisWorkbook.Path & "\TEST"
End If

mFile = Dir(ThisWorkbook.Path & "\csv檔\" & "*.csv")
Do While mFile <> ""
Workbooks.Open Filename:=ThisWorkbook.Path & "\csv檔\" & mFile
mFile = Dir()

mFile = Dir(ThisWorkbook.Path & "\TXT檔\" & "*.txt")
Do While mFile <> ""
Workbooks.Open Filename:=ThisWorkbook.Path & "\TXT檔\" & mFile
mFile = Dir()

Loop
Loop

Run "TXT複製至CSV"

End Sub

Sub TXT複製至CSV()

Workbooks(2).Activate
Workbooks(2).Worksheets.Add Before:=Sheets(Sheets.Count)
'活頁2(CSV)新增工作表

For i = 1 To Sheets.Count
Sheets(i).Name = "Sheet" & i
Next

Workbooks(3).Activate
Columns("A:A").Select
Selection.Copy
Workbooks(2).Activate
Sheets("Sheet1").Select
ActiveSheet.Paste
'將活頁3(TXT)資料複製至活頁2(CSV)

Application.CutCopyMode = False
Workbooks(3).Close

Run "另存TEST檔"

End Sub
Sub 另存TEST檔()

Filename = ActiveWorkbook.Name
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\TEST\" & Filename, _
FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
Application.WindowState = xlNormal
'另存TEST

ActiveWindow.Close SaveChanges:=False

End Sub

附件檔案可以試跑，再麻煩幫我看看....謝謝