Auto_open to check for folder

[Guest]

I want my Auto_open file to check to see if there is a folder and if not
create it
Something like
user = Application.username
If "//server3/jobs/user/" exists then
do something
Else
create the user folder

 

[Mark Ivey]

Jay,

Steve Yandl posted a solution for part of your problem (please scroll down
below this post to see his message).

To alter what he had a bit and get to what you were wanting, give this a
try:

In your Personal.xls workbook, put this code into "ThisWorkbook"

Private Sub Workbook_Open()
user = Application.UserName

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("\\server3\jobs\" & user)
strUserFolder = objFolder.Self.Path

If fso.FolderExists(strUserFolder & "\" & user) Then
'Do something
MsgBox "The folder already exists"
ElseIf Not fso.FolderExists(strUserFolder & "\" & user) Then
Set fldr = fso.CreateFolder(strUserFolder & "\" & user)
End If

Set objShell = Nothing
Set fso = Nothing

End Sub

***********************************************************
*************** Original Post from Steve Yandl *******************
***********************************************************

 

[Dave Peterson]

One way to check to see if a folder exists:

Option Explicit
Sub Auto_Open()

Dim TestStr As String
Dim FolderName As String

FolderName = "\\server3\jobs\" & application.username

If Right(FolderName, 1) <> "\" Then
FolderName = FolderName & "\"
End If

TestStr = ""
On Error Resume Next
TestStr = Dir(FolderName & "nul")
On Error GoTo 0

If TestStr = "" Then
MsgBox FolderName & " not found"
Else
MsgBox FolderName & " was found"
End If

End Sub

Another way is go use File System Object.

Option Explicit
Sub Auto_Open()
Dim FSO As Object
Dim FolderName As String

FolderName = "\\server3\jobs\" & Application.UserName

Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists(FolderName) = False Then
MsgBox FolderName & " not found"
Else
MsgBox FolderName & " was found"
End If
End Sub

 

[Guest]

What I am attempting to is when a new user (not on my machine) opens this
Workbook it will add his personal folder to the server. Will your routine
work under this condition?

oldjay

 

[Rick Rothstein \(MVP - VB\)]

One way to check to see if a folder exists:

Option Explicit
Sub Auto_Open()

Dim TestStr As String
Dim FolderName As String

FolderName = "\\server3\jobs\" & application.username

If Right(FolderName, 1) <> "\" Then
FolderName = FolderName & "\"
End If

TestStr = ""
On Error Resume Next
TestStr = Dir(FolderName & "nul")
On Error GoTo 0

If TestStr = "" Then
MsgBox FolderName & " not found"
Else
MsgBox FolderName & " was found"
End If

End Sub

Another way is go use File System Object.

Option Explicit
Sub Auto_Open()
Dim FSO As Object
Dim FolderName As String

FolderName = "\\server3\jobs\" & Application.UserName

Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists(FolderName) = False Then
MsgBox FolderName & " not found"
Else
MsgBox FolderName & " was found"
End If
End Sub

And here is yet another way to see if a folder exists...

Private Function FolderExists(PathName As String) As Boolean
On Error Resume Next
If Len(PathName) > 0 Then
FolderExists = ((GetAttr(PathName) And vbDirectory) > 0)
Err.Clear
End If
End Function

Here is the companion file exists funciton...

Private Function FileExists(FileName As String) As Boolean
On Error Resume Next
If Len(FileName) > 0 Then
FileExists = ((GetAttr(FileName) And vbDirectory) = 0)
Err.Clear
End If
End Function

Rick

 

[Mark Ivey]

Ahhh...

Yes this same procedure should work. Just place it in the "ThisWorkbook"
section of the active workbook and it should perform the same thing, except
for that workbook only...


Mark Ivey