VBA create a folder and add a file.

[Pinaceous]

Hi All,

I have a code to create a folder onto the desktop but I would like to know how I can insert a file, upon the execution of the code, automatically from the code into the newly created folder?

Sub CreateFolders()

  Dim sPath As String, sMain As String, sFolder As String
  Dim i As Long
 
  sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
  sMain = sPath & "\" & Sheets(1).Range("A1").Value
    
  If Dir(sMain) = "" Then
    MkDir sMain

'Add file Test.pdf from "C:\MISC\Test.pdf" 

  End If

 
End Sub

For example, if I have a file named "Test.pdf" into the folder creation, if I tell the code where the file is on my computer.

Please let me know, if you can help me.

Thank you,
pinaceous

 

[Dossfm0q]

Hi
Your Feedback is highly appreciated and your support with

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("A1").Value
   
  If Dir(sMain, vbDirectory) = "" Then MkDir sMain

    If Dir(sMain, vbDirectory) <> "" Then

    ' FSO.MoveFile Source:="C:\MISC\Test.pdf", Destination:=sMain & "\Test.pdf" ' copy and delete from source
    FSO.copyFile Source:="C:\MISC\Test.pdf", Destination:=sMain & "\Test.pdf" ' just copy

    End If
Set FSO = Nothing
End Sub

 

[Pinaceous]

Wow great code! That is what I was looking for. BTW, is there any way to improvise the code to auto-detect if the folder exists then not run the sub?

 

[Dossfm0q]

Sorry do you mean like this

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("A1").Value
  
  If Dir(sMain, vbDirectory) <> "" Then 'if the folder exists
  'Do nothing
  Else ' 'if the folder not exists
      MkDir sMain
        FSO.copyFile Source:="C:\MISC\Test.pdf", Destination:=sMain & "\Test.pdf" ' just copy
    
    End If
Set FSO = Nothing
End Sub

 

[Pinaceous]

Dossfm0q,

Hey thanks for the code!!

That should do it!

 

[Dossfm0q]

You are welcome

 

[Pinaceous]

Hey Dossfm0q,

I'm coming back to this topic because I would like to know if it is possible to reference the name of the file listed within the FSO line of the code, within in workbook itself?

Something like, for example;

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

I tried this out but I'm getting a syntax error.

Please let me know.

Thank you,
pinaceous

 

[Michael M]

I think you need to remove the quote after the Range value

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

 

[Pinaceous]

Thanks Michael! I'll try it out and report back. Thanks again for your post. I appreciate your efforts. ✌

 

[Pinaceous]

Hey Michael,

The code works great but I noticed that it has trouble recognizing files that begin with an open prentices.

For example, if I use your code in Post#8 with a file that is named upon the sheet:

(2-STEP)2020 .xlsm

It will not pick it up as a file to be moved.

Would you have any idea on how I can go around this in using your code?

Many thanks,
pinaceous