Solved: Create folders in vba

[sassora]

At work we use excel as a work log and can click on a hyperlink that links to the folders of work people have produced.

It seems like a good idea to create a macro that will create the work folder too (to save people from having to do it manually)
I am looking for a user friendly function that will work as follows.

On click of cell (or similar) - this will be in the same row as the entry.

1. Has user written their entry (fills in at least cells at column A and C)?
If NO then display a message saying to fill them in.
If YES then continue to 2.

2. Does the folder already exist?
If NO then create folder and give completion message
If YES give message saying that the folder exists

This is a collection of how I think the code might go, it's not fully functioning yet.

Any suggestions?

Sub FolderCreator()
Set Target = ActiveCell
'Define the date
Application.Goto Range("A" & ActiveCell.Row), True
r = ActiveCell
'Define the job title
Application.Goto Range("C" & ActiveCell.Row), True
s = ActiveCell
t_left = Left(r & s, 1)
t_right = Right(r & s, 1)
 
link_folder = "C:\Documents and Settings\Username\Desktop\" & Right(Year(r), 2) & Right("0" & Month(r), 2) & "\"
link_subfolder = link_folder & Right(Year(r), 2) & Right("0" & Month(r), 2) & Right("0" & Day(r), 2) & "_" & s
 
If tleft <> " " And tright <> " " Then
For i = 2 To 65536
If Target.Address = "$M$" & i Then MkDir link_subfolder
Next i
End If

End Sub

[Simon Lloyd]

Perhaps something like this:
[VBA]Sub create_folder()
If Dir("C:\My Documents\NewPrivateFolder\") <> Sheets("Sheet1").Range("A1") Then
MkDir "C:\My Documents\NewPrivateFolder"
' creates a new folder in the existing folder C:\My Documents
Else: MsgBox "Folder exists"
End If
End Sub[/VBA]untested!

[sassora]

Thanks for your help. It's now sorted. Here is my final code.

[vba]
'Description: This code is to create folders in conjunction with the work log

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'If user is double clicking in column M then run Create_folder macro
If Target.Column = 13 Then Create_Folder
End Sub


Sub Create_Folder()
If ready = True Then

If testDir = True Then
MsgBox ("'" & targetPath & "'" & " already exists")

Else
MkDir targetPath
MsgBox ("Folder created")
End If

ElseIf ready = False Then MsgBox ("Make sure that date and title are filled in")

End If
End Sub


Function testDir() As Boolean

testDir = False

If Dir(targetPath, vbDirectory) = "" Then testDir = False Else: testDir = True
End Function


Function targetPath() As String
'Define the date
Application.Goto Range("A" & ActiveCell.Row), True
r = ActiveCell
'Define the job title
Application.Goto Range("C" & ActiveCell.Row), True
s = ActiveCell
targetPath = "C:\..." _
& Right(Year(r), 2) & Right("0" & Month(r), 2) & "\" & Right(Year(r), 2) _
& Right("0" & Month(r), 2) & Right("0" & Day(r), 2) & "_" & s
End Function


Function ready()
Application.Goto Range("A" & ActiveCell.Row), True
r = ActiveCell
Application.Goto Range("C" & ActiveCell.Row), True
s = ActiveCell
If r <> "" And s <> "" Then ready = True Else: ready = False
End Function
[/vba]