help edit code move file!!!

Nguyen Anh Dung

Board Regular
Joined
Feb 28, 2020
Messages
148
Office Version
  1. 2016
Platform
  1. Windows
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!!!
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
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

rollis13

Active Member
Joined
Jul 30, 2012
Messages
475
Office Version
  1. 2016
Platform
  1. Windows
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.
 
Last edited:

Nguyen Anh Dung

Board Regular
Joined
Feb 28, 2020
Messages
148
Office Version
  1. 2016
Platform
  1. Windows
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.
 

Forum statistics

Threads
1,143,677
Messages
5,720,249
Members
422,272
Latest member
ginkgoVil

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top