ย้าย file แบบมีเงื่อนไข

[predee16]

ต้องการย้าย file จาก "01_AP_INPUT" ไปไว้ folder "CombineFile" โดยมีเงื่อนไขก็คือ ถ้าชื่อเหมือนกัน (13 หลักข้างหน้า) ก็เอากลุ่มนี้ที่ชื่อเหมือนกันย้ายไปอยู่รวมกัน

Code: Select all

Sub MoveFile()
Dim FSO As Object
Dim fromdir As String
Dim Todir As String
Dim Fextension As String
Dim fnames As String

fromdir ="D:\01_AP_INPUT\"
Todir = "D:\CombineFile\"
Fextension = "*.xlsx"
fnames = Dir(fromdir & Fextension)
If Len(fnames) = 0 Then
MsgBox "No files" & fromdir
Exit Sub
End If

Set FSO = CreateObject("scripting.filesystemobject")
FSO.MoveFile Source:=fromdir & Fextension, Destination:=Todir


End Sub

[snasui]

กรุณาแนบ Code มาในไฟล์ด้วยครับ

หรือหากแนบมาแล้วช่วยแจ้งว่า Code อยู่ในตำแหน่งใด จะได้เข้าถึงปัญหาได้โดยไวครับ