Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

create new folder

Status
Not open for further replies.

jono261970

Programmer
Jun 28, 2002
182
GB
Hello,

I have a directory called USERS which contains about 200 user folders. What I now have to do is create a new folder in each of them called "MYWORK".


for example;

d:\users\jblogs

d:\users\jblogs\mywork

Is there anyway this can be acomplished in VB automatically.

thanks in advance

jono
 
[tt]
' Display the names in C:\ that represent directories.
MyPath = "c:\" ' Set the path.
MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
Do While MyName <> &quot;&quot; ' Start the loop.
' Ignore the current directory and the encompassing directory.
If MyName <> &quot;.&quot; And MyName <> &quot;..&quot; Then
' Use bitwise comparison to make sure MyName is a directory.
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName ' Display entry only if it
MkDir MyPath & MyName & &quot;\mywork&quot;
End If ' it represents a directory.
End If
MyName = Dir ' Get next entry.
Loop

[/tt]
 
Dim strDir As String

strDir = Dir(&quot;C:\Users\*.*&quot;, vbDirectory)
Do Until Len(strDir) = 0
If Left(strDir, 1) <> &quot;.&quot; Then
MkDir &quot;C:\Users\&quot; & strDir & &quot;\MYWORK&quot;
End If
strDir = Dir()
Loop
 
Code:
Option Explicit

Private Sub Command1_Click()
  Dim oSub As Object
  Dim oBase As Object
  Dim oFSO As Object
  Dim sBase As String
  Dim sNew As String
  Dim sNewPath As String
  
  sBase = &quot;d:\users\&quot;
  sNew = &quot;mywork&quot;
  
  Set oFSO = CreateObject(&quot;Scripting.FileSystemObject&quot;)
  Set oBase = oFSO.GetFolder(sBase)
  
  For Each oSub In oBase.SubFolders
    sNewPath = oSub.Path & &quot;\&quot; & sNew
    If Not oFSO.FolderExists(sNewPath) Then
      If oFSO.FileExists(sNewPath) Then
        MsgBox &quot;file with same name already exists&quot;
      Else
        oSub.SubFolders.Add sNew
      End If
    End If
  Next
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top