Solved I need a VBA code to create a directory under parent directory

[Capitala]

It seems impossible. However, it's significant to me.
if my current document is located in: (D:\works\123) for example. I need to create a folder under the upper (parent) directory (works) in this case.
How to create such folder. NB: Parent folder changes (like: D:\projects\reports) ....etc.
It should be made using VBA in word 2003 only.
Thanks for your precious time

 

[cheekybuddha]

Dim PathParts As Variant
Dim CurrentPath As String
Dim NewFolder As String
Dim NewPath As String

CurrentPath = "D:\works\123"
PathParts = Spilt(CurrentPath, "\")
NewFolder = "FolderName"
PathParts(UBound(PathParts)) = NewFolder
NewPath = Join(PathParts, "\")
MsgBox NewPath

 

[The_Doc_Man]

To create an actual folder, you can use MKDIR.

MkDir statement (VBA)

Office VBA reference topic

learn.microsoft.com

You can do this either of two ways.

1. If you KNOW (for a fact) that you are currently focused on the parent folder (i.e. the place where you want to create the new folder), you can issue a MKDIR "./<new-folder-name>" - like MKDIR "./NewFolder" - which creates the new folder (named NewFolder) using relative file naming. That is, the leading "./" construct says "relative to or starting from the current directory, create a subdirectory named NewFolder."

2. If you are NOT SURE of which directory is current, you can do the full path. MKDIR "C:\Users\Capitala\NewFolder" Since this string DID NOT start with the "./" it is taken as an absolute specification. For this to work correctly, the folders "above" the new folder should already exist.

 

[arnelgp]

you may also try:

Public Sub CreatePathFromRoot(Byval sNewPath as string)
Dim drv As String
drv = GetDrive()
sNewPath = Replace$(drv & "\" & sNewPath, "\\", "\")
On Error Resume Next
MkDir sNewPath
End Sub

Public Function GetDrive() As String
Dim f As Object, fso As Object
Set fso = CreateObject("scripting.filesystemobject")
set f = fso.GetFile(CurrentProject.Name)
GetDrive = f.Drive
set fso = Nothing
End Function

example:

Call CreatePathFromRoot("projects\reports")

 

[Capitala]

you may also try:

Public Sub CreatePathFromRoot(Byval sNewPath as string)
Dim drv As String
drv = GetDrive()
sNewPath = Replace$(drv & "\" & sNewPath, "\\", "\")
On Error Resume Next
MkDir sNewPath
End Sub

Public Function GetDrive() As String
Dim f As Object, fso As Object
Set fso = CreateObject("scripting.filesystemobject")
set f = fso.GetFile(CurrentProject.Name)
GetDrive = f.Drive
set fso = Nothing
End Function

example:

Call CreatePathFromRoot("projects\reports")

Regarding (set f = fso.GetFile(CurrentProject.Name)): variable not defined (CurrentProject.Name)

 

[Capitala]

Dim PathParts As Variant
Dim CurrentPath As String
Dim NewFolder As String
Dim NewPath As String

CurrentPath = "D:\works\123"
PathParts = Spilt(CurrentPath, "\")
NewFolder "FolderName"
PathParts(UBound(PathParts)) = NewFolder
NewPath = Join(PathParts, "\")
MsgBox NewPath

This one is working perfect. thanks cheeky

 

[Gasman]

Regarding (set f = fso.GetFile(CurrentProject.Name)): variable not defined (CurrentProject.Name)

Perhaps because Arnel thought this was an Access question.
This will get you your docoument path

Dim strPath as String
strPath = ThisDocument.Path