Code to create folder and inside subfolder

Hi.

The code below is sending back an error. It's supposed to create a folder and a subfolder within it and if the folder already exists then a msg box should pop up saying that folder already exists.

Private Sub CommandButton1_Click()
    
Dim xdir As String
Dim fso
Dim fsoSub
Dim lstrow As Long
Dim i As Long
Dim xdirsubfolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoSub = CreateObject("Scripting.FileSystemObject")
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To lstrow

If Dir("\\User\" & Me.Cells(1, "A").Value, vbDirectory) = "" Then

xdir = "\\User\" & Me.Cells(1, "A").Value
xdirsubfolder = "\\User\" & Me.Cells(1, "A").Value & "\" & Me.Cells(1, "A").Value.Offset(0, 3)

Else
        MsgBox "" & Me.Cells(1, "A").Value & " already exists"
End If

If Not fso.FolderExists(xdir) Then
fso.CreateFolder (xdir)
End If


If Not fsoSub.FolderExists(xdirsubfolder) Then
fsoSub.CreateFolder (xdirsubfolder)
End If


Next
Application.ScreenUpdating = True

End Sub