Copy all files from a list of file paths into a single folder - Microsoft Community
- Get link
- X
- Other Apps
hello,
i having big list of file paths in excel column 700 of them. music files .mp3 or .flac type. situated in different subfolders among other music file, , of them in 1 parent folder 'music'. need vba code copies of files single folder of choosing, let 'backup'.
is there way of vba doing me or should somewhere else?
file paths this:
c:/music/hip_hop/dre/california love.mp3
c:/music/house/dino/wake (original mix).flac
c:/music/deep_house/topcharts/forget me.flac
thanks!
iliya
moved from: office / excel / windows 10 / office 365 home
the listed paths have forward slashes whereas genuine paths have slashes, have account (as in macro).
apart quite straightforward. necessary ensure file exists @ excel named location before attempting copy it.
assuming paths in column following should work
option explicit
sub copytobackup()
'graham mayor - http://www.gmayor.com - last updated - 19 nov 2017
dim long
dim xlsheet worksheet
dim lastrow long
dim strpath string
dim vname variant
dim strtarget string
set xlsheet = activesheet
strtarget = browseforfolder("select folder save backup copies")
xlsheet
lastrow = .cells(.rows.count, "a").end(xlup).row
= 2 lastrow 'if no header row, use 1 lastrow
strpath = .cells(i, 1)
strpath = replace(strpath, "/", "\")
if fileexists(strpath) then
vname = split(strpath, "\")
filecopy strpath, strtarget & vname(ubound(vname))
end if
doevents
next i
end with
lbl_exit:
set xlsheet = nothing
exit sub
end sub
private function browseforfolder(optional strtitle string) string
'graham mayor
'strtitle title of dialog box
dim fdialog filedialog
on error goto err_handler
set fdialog = application.filedialog(msofiledialogfolderpicker)
fdialog
.title = strtitle
.allowmultiselect = false
.initialview = msofiledialogviewlist
if .show <> -1 goto err_handler:
browseforfolder = fdialog.selecteditems.item(1) & chr(92)
end with
lbl_exit:
exit function
err_handler:
browseforfolder = vbnullstring
resume lbl_exit
end function
private function fileexists(strfullname string) boolean
'graham mayor
'strfullname name path of file check
dim fso object
set fso = createobject("scripting.filesystemobject")
if fso.fileexists(strfullname) then
fileexists = true
else
fileexists = false
end if
lbl_exit:
set fso = nothing
exit function
end function
Office / Excel / Microsoft Office Programming / Office 365 Home
- Get link
- X
- Other Apps
Comments
Post a Comment