CreateFolder from Worksheet Columns
I did not get those results. Does it have anything to do with the Sub
StartHere?
"Dave Peterson" wrote:
You should see the counter in parentheses.
These were the folder names I got in my tests (of the newest version!!!):
C:\Test\asdf-qwer
C:\Test\asdf-qwer(01)
C:\Test\asdf-qwer(02)
C:\Test\asdf-qwer(03)
C:\Test\asdf-qwer(04)
C:\Test\asdf-qwer(05)
C:\Test\asdf-qwer(06)
C:\Test\asdf-qwer(07)
C:\Test\asdf-qwer(08)
C:\Test\asdf-qwer(09)
C:\Test\asdf-qwer(10)
C:\Test\asdf-qwer(11)
C:\Test\asdf-qwer(12)
C:\Test\asdf-qwer(13)
C:\Test\asdf-qwer(14)
C:\Test\asdf-qwer(15)
C:\Test\asdf-qwer(16)
C:\Test\asdf-qwer(17)
C:\Test\asdf-qwer(18)
C:\Test\asdf-qwer(19)
C:\Test\asdf-qwer(20)
Kerry wrote:
I got it working. Is there away to appent eCtr to the Folder Name?
"Dave Peterson" wrote:
Untested, uncompiled...
Dim eCtr as long 'near your other declarations in CreateFolders
....
If Len(Dir(sBaseFolder & sTemp)) = 0 Then
'doesn't exist.
'Use MkDir to create the folder
MkDir sBaseFolder & sTemp
else
ectr = 0
do
ectr = ectr + 1
on error resume next
mkdir sbasefolder & stemp & "(" & ectr & ")"
if err.number = 0 then
'directory was created, so get out
exit do
end if
'keep looking
loop
end if
....
Kerry wrote:
Dave...Your code works although I found one issues with my data. Several
companies have multiple offices in the same location. So when the folder is
created and the code attempts to create the next company folder I get an
error because it is attempting to create a folder with the same name and
city. Is there away I can append a number to the folder based on some sort of
count to make the folder unique? E.g.
Column A- Column F(#)
TVC Capital LLC-Del Mar(1)
TVC Capital LLC-Del Mar(2)
I have several hundred companies with multiple branches in the same City.
Thanks for your assistance.
Kerry
"Dave Peterson" wrote:
Maybe...
Sub StartHere()
Dim rCell As Range
Dim rRng As Range
with Sheet1
set rRng = .range("A2",.cells(.rows.count,"A").end(xlup))
end with
For Each rCell In rRng.Cells
CreateFolders rCell.Value & "-" & rcell.offset(0,5).value, "C:\Test"
Next rCell
End Sub
rCell is in column A. .offset(0,5) is 5 columns to the right (column F).
Kerry wrote:
I have this code that loops through my worksheet and create new folders. I
need to use multiple columns to create my folder such as CompanyName in
Column A and CompanyCity in Column F. I would like to use a dash or
parentecies between the CompanyName and CompanyCity e.g.
CompanyName-CompanyCity.
Sub StartHere()
Dim rCell As Range, rRng As Range
Set rRng = Sheet1.Range("C2:C100")
For Each rCell In rRng.Cells
CreateFolders rCell.Value, "C:\Test"
Next rCell
End Sub
Sub CreateFolders(sSubFolder As String, ByVal sBaseFolder As String)
Dim sTemp As String
'Make sure the base folder is ready to have a sub folder
'tacked on to the end
If Right(sBaseFolder, 1) < "\" Then
sBaseFolder = sBaseFolder & "\"
End If
'Make sure base folder exists
If Len(Dir(sBaseFolder, vbDirectory)) 0 Then
'Replace illegal characters with an underscore
sTemp = CleanFolderName(sSubFolder)
'See if already exists: Thanks Dave W.
If Len(Dir(sBaseFolder & sTemp)) = 0 Then
'Use MkDir to create the folder
MkDir sBaseFolder & sTemp
End If
End If
End Sub
Function CleanFolderName(ByVal sFolderName As String) As String
Dim i As Long
Dim sTemp As String
For i = 1 To Len(sFolderName)
Select Case Mid$(sFolderName, i, 1)
Case "/", "\", ":", "*", "?", "<", "", "|"
sTemp = sTemp & "_"
Case Else
sTemp = sTemp & Mid$(sFolderName, i, 1)
End Select
Next i
CleanFolderName = sTemp
End Function
--
Dave Peterson
--
Dave Peterson
--
Dave Peterson
|