How to change directory in this code

[Prasad K]

Can anyone tell me how can I change directory in this code
Like this code will create folder and sub folder on desktop

I want to change the directory to D:\ or E:\

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
  End If

  For i = 1 To 10
    sFolder = sMain & "\" & Sheets(1).Range("B" & i).Value
    If Dir(sFolder) = "" Then
      MkDir sFolder
    End If
  Next
End Sub

 

[Micron]

perhaps add
Dim strDrive As String and get the drive letter as an input?

sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
  strDrive = InputBox("Drive letter only")
  sPath = Replace(sPath, Left(sPath, 1), strDrive)
  Debug.Print sPath
  sMain = sPath & "\" & Sheets(1).Range("A1").Value

You didn't say what was going to provide the alternate drive letters, so I used an input box. There is no testing here to ensure only a single valid drive letter is input because I don't even know if an input box is relevant here. Don't forget to comment out the debug line if you use that.

 

[Prasad K]

perhaps add
Dim strDrive As String and get the drive letter as an input?

sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
  strDrive = InputBox("Drive letter only")
  sPath = Replace(sPath, Left(sPath, 1), strDrive)
  Debug.Print sPath
  sMain = sPath & "\" & Sheets(1).Range("A1").Value

You didn't say what was going to provide the alternate drive letters, so I used an input box. There is no testing here to ensure only a single valid drive letter is input because I don't even know if an input box is relevant here. Don't forget to comment out the debug line if you use that.

Ok sir I will try this

My query is how to change directory path in that code

 

[Prasad K]

perhaps add
Dim strDrive As String and get the drive letter as an input?

sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
  strDrive = InputBox("Drive letter only")
  sPath = Replace(sPath, Left(sPath, 1), strDrive)
  Debug.Print sPath
  sMain = sPath & "\" & Sheets(1).Range("A1").Value

You didn't say what was going to provide the alternate drive letters, so I used an input box. There is no testing here to ensure only a single valid drive letter is input because I don't even know if an input box is relevant here. Don't forget to comment out the debug line if you use that.

getting run time error see the below image

i don't want inputbox is this code just change directory path to any Drive or D:\ or E:\

 

[Micron]

You forgot Dim strDrive As String - not that it will fix the error.

You need to say how it is decided to change it to one or the other. The input box would be only one way. Perhaps the choice is coming from a textbox? A combobox? Coin flip? Something else?

Did you type either D or E into the input box to at least test it?
What does the debug.print show in the immediate window?

This line
If Dir(sMain) = "" Then

does not err for me, but I'm not going to allow it to go further and start creating directories on my pc.

 

[Prasad K]

You forgot Dim strDrive As String - not that it will fix the error.

You need to say how it is decided to change it to one or the other. The input box would be only one way. Perhaps the choice is coming from a textbox? A combobox? Coin flip? Something else?

Did you type either D or E into the input box to at least test it?
What does the debug.print show in the immediate window?

This line
If Dir(sMain) = "" Then

does not err for me, but I'm not going to allow it to go further and start creating directories on my pc.

I don't want input box in this code just change directory path

Now that code have directory to Create folder and sub folders on Desktop

Just change the directory to D: drive from desktop on code

 

[Micron]

This will replace C with D. If it can be anything other than C you will need a variable for the drive letter being changed. Again, you'll want to rem out the debug line when testing is finished.

  Dim sPath As String, sMain As String, sFolder As String
  Dim i As Long
  
  sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
  sPath = Replace(sPath, "C", "D")
  Debug.Print sPath
  sMain = sPath & "\" & Sheets(1).Range("A1").Value

 

[Prasad K]

This will replace C with D. If it can be anything other than C you will need a variable for the drive letter being changed. Again, you'll want to rem out the debug line when testing is finished.

  Dim sPath As String, sMain As String, sFolder As String
  Dim i As Long
 
  sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
  sPath = Replace(sPath, "C", "D")
  Debug.Print sPath
  sMain = sPath & "\" & Sheets(1).Range("A1").Value

getting run time error not working

 

[Micron]

You need to answer questions asked:

What does the debug.print show in the immediate window?

change to this and copy and paste the output from the immediate window in your next post. If you don't do that, I don't think I can help further.

 sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
  sPath = Replace(sPath, "C", "D")
  Debug.Print "sPath is " & sPath
  sMain = sPath & "\" & Sheets(1).Range("A1").Value
  Debug.Print "sMain is " & sMain

Or look at the paths in the immediate window and figure out why it is invalid. It should be obvious whether or not there is such a path, right from "D" to the very end - or not.

 

[Prasad K]

You need to answer questions asked:

change to this and copy and paste the output from the immediate window in your next post. If you don't do that, I don't think I can help further.

 sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
  sPath = Replace(sPath, "C", "D")
  Debug.Print "sPath is " & sPath
  sMain = sPath & "\" & Sheets(1).Range("A1").Value
  Debug.Print "sMain is " & sMain

Or look at the paths in the immediate window and figure out why it is invalid. It should be obvious whether or not there is such a path, right from "D" to the very end - or not.

this one also getting same error

MkDir sMain

thank you for helping me to writing code again and again just now i have get one vba code in google search it's working for me i will go with that code

Sub CreateFoldersandSubFolders()
   Dim pth As String, FullPth As String
   Dim Cl As Range
   Dim i As Long
   
   pth = "D:\"
   If Right(pth, 1) <> "\" Then pth = pth & "\"
   With Sheets("Sheet1")
      For Each Cl In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
         FullPth = pth & Cl.Value & "\"
         If Not FldrExists(FullPth) Then MkDir FullPth
         For i = 1 To .Cells(Cl.Row, Columns.Count).End(xlToLeft).Column - 1
            FullPth = FullPth & Cl.Offset(, i).Value & "\"
            If Not FldrExists(FullPth) Then MkDir FullPth
         Next i
         FullPth = pth
      Next Cl
   End With
End Sub
Function FldrExists(DirPth As String) As Boolean
   FldrExists = Dir(DirPth, vbDirectory) <> ""
End Function