Sub same_name()
ThisWorkbook.Sheets("Sheet1").[D1] = "T"
Sheets("Sheet1").Select
Range("D2").Select
Selection.ClearContents
fd = [a1]
fs = Dir(fd & "*.txt")
Do Until fs = ""
Cells(2, 4) = Mid(fs, 1, 8)
If ThisWorkbook.Sheets("Sheet1").[D1] = ThisWorkbook.Sheets("Sheet1").[D2] Then
Cells(1 + r, 6) = fs
r = r + 1
'MsgBox "檔案重複,檔名:" & fs, vbOKOnly, "錯誤訊息"
'Exit Sub
End If
ThisWorkbook.Sheets("Sheet1").[D1] = ThisWorkbook.Sheets("Sheet1").[D2]
fs = Dir
Loop
End Sub