Create Folders from Column Cells using FSO

[Pinaceous]

Hi All,

I'm working with

FSO = CreateObject("Scripting.FileSystemObject")

where I have my code produce a Main Folder based off of its workbooks sheet cell value as its name.

Now, I would like to create a subfolders to put inside this Main Folder in using FSO.



So, far I have as follows:

Sub CreateFolders()

Dim FSO As Object, sourceFolder As Object, file As Object

  Dim sPath As String, sMain As String, sFolder As String
  Dim i As Long

    Set FSO = CreateObject("Scripting.FileSystemObject")
    sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    sMain = sPath & "\" & ThisWorkbook.Sheets(1).Range("B11").Value
      
  If Dir(sMain, vbDirectory) <> "" Then 'if the folder exists
  'Do nothing
    MsgBox "Duplicate Folder!"
    'MsgBox Application.UserName & "Duplicate Folder!"
    'MsgBox Environ("Temp") & " Hello!"
  
  Exit Sub
 
  Else ' 'if the folder not exists
      MkDir sMain
   
       FSO.MoveFile Source:="C:\Users\Desktop\" & Sheets(1).Range("E25").Value, Destination:=sMain & "\" & Sheets(1).Range("E25").Value

        'FSO.MoveFile Source:="C:\Users\Desktop\" & Sheets(1).Range("E31").Value, Destination:=sMain & "\" & Sheets(1).Range("E31").Value

        'FSO.MoveFile Source:="C:\Users\Desktop\" & Sheets(1).Range("E37").Value, Destination:=sMain & "\" & Sheets(1).Range("E37").Value

    End If
  
Set FSO = Nothing

 For i = 11 To 23
    sFolder = sMain & "\" & Sheets(1).Range("C" & i).Value
     
    If Dir(sFolder) = "" Then
      MkDir sFolder
    End If
  Next


End Sub

I'm getting an error with this line

 FSO.CreateFolder "FSO.MoveFile Source:="C:\Users\Desktop\" & Sheets(1).Range("E25").Value, Destination:=sMain & "\" & Sheets(1).Range("E25").Value

.

Can someone help me?

Thanks!
pinaceous

 

[Domenic]

Hi pinaceous,

It looks like it should be...

FSO.MoveFile Source:="C:\Users\Desktop\" & Sheets(1).Range("E25").Value, Destination:=sMain & "\" & Sheets(1).Range("E25").Value

Also, when that line is executed, it looks like the folder sMain & "\" & Sheets(1).Range("E25").Value does not exist.

Cheers!

 

[Pinaceous]

Hi Domenic!

Okay, I've corrected that line to

FSO.Movefile "C:\Users\Desktop\" & Sheets(1).Range("E25").Value, sMain & "\" & Sheets(1).Range("E25").Value

But I'm getting an error probably because of what you already suggested:

Also, when that line is executed, it looks like the folder sMain & "\" & Sheets(1).Range("E25").Value does not exist.

Do you know how I can rewrite this line of the code to make it work??

Please let me know.

Many thanks!

Pinaceous

 

[Pinaceous]

Its giving me File not found (Error 53) even if I go to the length and provide:

FSO.Movefile Source:="C:\Users\Desktop\myfile .xlsm" & ThisWorkbook.Sheets(1).Range("E25").Value, Destination:="C:\Users\Desktop\myfile .xlsm" & "\" & ThisWorkbook.Sheets(1).Range("E25").Value

 

[Domenic]

Hi Domenic!

Okay, I've corrected that line to

FSO.Movefile "C:\Users\Desktop\" & Sheets(1).Range("E25").Value, sMain & "\" & Sheets(1).Range("E25").Value

But I'm getting an error probably because of what you already suggested:




Do you know how I can rewrite this line of the code to make it work??

Please let me know.

Many thanks!

Pinaceous

Try...

'create the destination folder
MkDir sMain & "\" & Sheets(1).Range("E25").Value

'move file to newly created folder
FSO.Movefile "C:\Users\Desktop\" & Sheets(1).Range("E25").Value, sMain & "\" & Sheets(1).Range("E25").Value

 

[Pinaceous]

Try...

'create the destination folder
MkDir sMain & "\" & Sheets(1).Range("E25").Value

'move file to newly created folder
FSO.Movefile "C:\Users\Desktop\" & Sheets(1).Range("E25").Value, sMain & "\" & Sheets(1).Range("E25").Value

Thanks Domenic! Good working with you again! Respectfully, pinaceous

 

[Domenic]

You're very welcome, glad I could help.

Cheers!