help edit code move file!!!

[Nguyen Anh Dung]

i have soure folder fromPath = "C:\Users\Admin\Desktop\CG\" include file csv as below
20200425_06_002_QGV_GS013858_01_360_updated_0
20200425_06_002_QGV_GS013858_01_updated_0
20200425_06_001_QGV_GS013858_01_updated_0
and destionfolder
toPath = "C:\Users\Admin\Desktop\Test\"
20200425_06_001_QGV_GS013858_01
20200425_06_002_QGV_GS013858_01
in this case folder exists then move file ok.
but folder not exists i have create folder but move file not correct
If Len(Dir(toSubPath, vbDirectory)) = 0 Then MkDir toSubPath
help me edit code!!!

Option Explicit
Sub MoveFiles()
Dim fName As String, fromPath As String, toPath As String
Dim toSubPath As String, cnt As Long
Dim toSubPath1 As String, cnt1 As Long
On Error Resume Next
'fromPath = Application.InputBox("Nhap duong dan nguon: ")
'toPath = Application.InputBox("Nhap duong dan dich: ")

toPath = "C:\Users\Admin\Desktop\Test\" 'duong dan muon move den
fromPath = "C:\Users\Admin\Desktop\CG\" 'duong dan chua file csv

fName = Dir(fromPath & "*.csv")
Do While Len(fName) > 10

If Right(fName, 14) = "_updated_0.csv" Then
cnt = 0
toSubPath = toPath & Left(fName, Len(fName) - 14) & "\"
'If Len(Dir(toSubPath, vbDirectory)) = 0 Then MkDir toSubPath
'If Dir(toSubPath, vbDirectory) = "" Then MkDir toSubPath

Name (fromPath & fName) As (toSubPath & fName)

End If
If Right(fName, 18) = "_360_updated_0.csv" Then
cnt = 0
toSubPath = toPath & Left(fName, Len(fName) - 18) & "\"

Name (fromPath & fName) As (toSubPath & fName)

End If
fName = Dir
Loop

MsgBox "Ho" & ChrW(224) & "n Th" & ChrW(224) & "nh !!!"
cnt = cnt + 1


End Sub

Thanks you abd Best regards,
Nguyen Anh DUng

 

[rollis13]

I suggest that you should temporarily disable this line of code On Error Resume Next so you can see in the Debug the reason of any problem.
Anyway, do you already have a subfolder called "Test" elsewise you will never get to use this line of code: If Len(Dir(toSubPath, vbDirectory)) = 0 Then MkDir toSubPath to create your new subfolder named like your file.

 

[Nguyen Anh Dung]

yes, thanks you so much!!!

I suggest that you should temporarily disable this line of code On Error Resume Next so you can see in the Debug the reason of any problem.
Anyway, do you already have a subfolder called "Test" elsewise you will never get to use this line of code: If Len(Dir(toSubPath, vbDirectory)) = 0 Then MkDir toSubPath to create your new subfolder named like your file.