PDA

View Full Version : Create New Folder Based on Cell Name and Copy Files into it



mattmar
08-26-2020, 06:17 AM
Hi All,

I am new in VBA.
I would like to create new folder based on cell value in a sheet (Sheet3 (Cover Page) Cell B4) and with this new folder, I would like to copy multiple documents from the list (Sheet 4 Cell B5:B30) from source folder into created folder. The document list is with extension (.pdf, .docx, etc). In addition, I also would like to prevent to create folder with same name.
At this moment, I can make new folder based on cell and also can copy document in the list, but don't know how combine this two things.
Any help would be appreciated.
Thanks in advance.




'This code is for create new folder based on cell value
Sub makenewfolder()
Dim startPath As String
Dim myName As String
startPath = "H:\SantosoM\"
myName = ThisWorkbook.Sheets("Cover Page").Range("B4").Text
If myName = vbNullString Then myName = "Testing"
Dim folderPathWithName As String
folderPathWithName = startPath & Application.PathSeparator & myName
If Dir(folderPathWithName, vbDirectory) = vbNullString Then
MkDir folderPathWithName
Else
MsgBox "Folder already exists"
Exit Sub
End If
End Sub

'This code for copy files from the document list
Sub copyfiles()

Const sourcePath As String = "C:\Users\"
Const DestPath As String = "H:\User\"
Const ListAddress As String = "B5:B30"

' Write file list to array.
Dim FileList As Variant: FileList = Sheet4.Range(ListAddress).Value

' 'Get' first file name.
Dim FName As String: FName = Dir(sourcePath)
' 'Initiate' counter.
Dim i As Long
' Loop files in SourcePath.
Do While FName <> ""
' Check if file name of current file is contained in array (FileList).
If Not IsError(Application.Match(FName, FileList, 0)) Then
' Count file.
i = i + 1
' Copy file.
FileCopy sourcePath & FName, DestPath & FName
End If
' 'Get' next file name.
FName = Dir()
Loop

' Inform user.
Select Case i
Case 0: MsgBox "No files found", vbExclamation, "No Files"
Case 1: MsgBox "Copied 1 file.", vbInformation, "Success"
Case Else: MsgBox "Copied " & i & " files.", vbInformation, "Success"
End Select
End Sub

snb
08-26-2020, 06:30 AM
Sub M_snb()
c00=sheet3.cells(4,2)
if dir(cc,16)="" then mkdir c00

sn=sheet4.range("B5:B30")

for j=1 to ubound(sn)
filecopy sn(j,1) , c00 & dir(sn(j,1))
next
End Sub

mattmar
08-26-2020, 06:58 AM
Sub M_snb()
c00=sheet3.cells(4,2)
if dir(cc,16)="" then mkdir c00

sn=sheet4.range("B5:B30")

for j=1 to ubound(sn)
filecopy sn(j,1) , c00 & dir(sn(j,1))
next
End Sub

Hi snb,

Thank you for your answer. What is dir (cc, 16)?

snb
08-26-2020, 07:02 AM
Corrected typo:


Sub M_snb()
c00=sheet3.cells(4,2)
sn=sheet4.range("B5:B30")

if dir(c00,16)="" then mkdir c00

for j=1 to ubound(sn)
filecopy sn(j,1) , c00 & dir(sn(j,1))
next
End Sub

mattmar
08-26-2020, 07:15 AM
Corrected typo:


Sub M_snb()
c00=sheet3.cells(4,2)
if dir(c00,16)="" then mkdir c00



sn=sheet4.range("B5:B30")

for j=1 to ubound(sn)
filecopy sn(j,1) , c00 & dir(sn(j,1))
next
End Sub


And where I have to put my source and destination folder in this code?

snb
08-26-2020, 07:19 AM
Please, do not quote !