VBS / Access 2k script question

[usmc-ratman]

Platform: WinXP / Access 2k

Can someone assist me in a script that would be part of access and will do the following:
1) Press 1st button on a form that will create a folder based on a field entry on that form
---ie: field name [clientname] with entry in the field as "Smith, John Doe (8/14/06)"
a) If the folder already exists either give a warn message that it already exists
b) Gives the option to cancel this routine (creating the folder), and open the folder.

2) Press 2nd button on a form that will open a folder based on the [clientname] field that the current record is on.

** All the folders being created would be in a central server file that all computers have read/write access to, and is designated as the "L" drive in their networks.

** A consideration would be the folder name creation, since some of the [clientname] fields do include / may include invalid characters for folder names, so that in the example above, the "/"s would be changed to "-"s

I do understand access pretty well (but am always learning), and have limited knowledge on scripting, so any help would be greatly appreciated.

Thanx - JR
Semper Fi

 

[Rickster57]

folders

You will need to replace those / as you indicated. If your form uses a query create an expression like Expr1:replace([clientname],"/","-") this will get rid of the / and replace with - or whatever you want to use. That expr1 should be placed on your form and will be used to see if the folder exists.

dim thefolder as string
thefolder=me.expr1

Folder exists : if dir("C\myfolder\" & thefolder)="" then
'the folder does not exist 'make the folder
mkdir("C:\myfolder\" & thefolder)
else
msgbox("This folder already exists.")
end if

Hopefully this will get you started

 

[usmc-ratman]

Rickster - This is what code someone else was working on for me, and we only have one problem when executing the code, the last action (the call procedure that is supposed to open the directory) is being hampered by the ','s in the clientname field.

We are looking for a solution to include the comma in the naming of the folders, because there is already about a 1000 folders with the commas.

If you know how to include the comma in the call procedure, that would be great.

Thanks,
JR

'this function replaces invalid characters with "-"
Function Validated_Name(StrIn As String) As String
    Dim InvalidChars As String
    InvalidChars = ""
    Validated_Name = ""
    
    For i = 1 To 6
        InvalidChars = InvalidChars & Chr(CInt(Mid("034039047092058124", (i - 1) * 3 + 1, 3)))
    Next
    For i = 1 To Len(StrIn)
        If InStr(InvalidChars, Mid(StrIn, i, 1)) <> 0 Then
            Validated_Name = Validated_Name & "-"
        Else
            Validated_Name = Validated_Name & Mid(StrIn, i, 1)
        End If
    Next
End Function

Function Folder_Exists(StrIn As String) As Boolean
    ChDir ("C:\data files\databases")
    Sample = Dir(StrIn, vbDirectory)
    If Sample = "" Then
        Folder_Exists = False
    Else
        Folder_Exists = True
    End If
End Function
    
Private Sub Button1_Click()
    Dim FldrName As String
        
    FldrName = (Validated_Name(Me.edbx1.Value))
    If Folder_Exists(FldrName) Then
        answ = MsgBox("Folder exists. Open it?", vbYesNo)
        If answ = vbYes Then Call Shell("explorer.exe " & CurDir & FldrName, 1)
    Else
        answ = MsgBox("Folder doesn't exist. Create?", vbYesNo)
        If answ = vbYes Then
            MkDir (FldrName)
            answ = MsgBox("Folder created. Open it now?", vbYesNo)
            MsgBox ("Folder in question is: " & CurDir & "\" & FldrName)                          
            If answ = vbYes Then Call Shell("explorer.exe " & CurDir & FldrName, 1)
        End If
    End If
    
End Sub

 

[usmc-ratman]

Rickster - Just letting you know that we have solved the problem. Things are working fine now....

Thanks for your input

 

[gemma-the-husky]

out of interest how did you solve it?

did it just need a char(34) either side of the path in the shell statement?

 

[usmc-ratman]

Gemma -

Here is the final code for the procedure. Will come in handy with other databases that I create.​

'this function replaces invalid characters with "-"
Function Validated_Name(StrIn As String) As String
    Dim InvalidChars As String
    InvalidChars = ""
    Validated_Name = ""
    
    For i = 1 To 6
        InvalidChars = InvalidChars & Chr(CInt(Mid("034039047092058124", (i - 1) * 3 + 1, 3)))
    Next
    For i = 1 To Len(StrIn)
        If InStr(InvalidChars, Mid(StrIn, i, 1)) <> 0 Then
            Validated_Name = Validated_Name & "-"
        Else
            Validated_Name = Validated_Name & Mid(StrIn, i, 1)
        End If
    Next
End Function

Function Folder_Exists(StrIn As String) As Boolean
    ChDir ("C:\data files\databases")
    Sample = Dir(StrIn, vbDirectory)
    If Sample = "" Then
        Folder_Exists = False
    Else
        Folder_Exists = True
    End If
End Function
    
Private Sub Button1_Click()
    Dim FldrName As String
        
    FldrName = (Validated_Name(Me.edbx1.Value))
    If Folder_Exists(FldrName) Then
        answ = MsgBox("Folder exists. Open it?", vbYesNo)
        If answ = vbYes Then Call Shell("explorer.exe " & Chr(34) & CurDir & "\" & FldrName & Chr(34), 1)
    Else
        answ = MsgBox("Folder doesn't exist. Create?", vbYesNo)
        If answ = vbYes Then
            MkDir (FldrName)
            answ = MsgBox("Folder created. Open it now?", vbYesNo)
            MsgBox ("Folder in question is: " & CurDir & "\" & FldrName)
            If answ = vbYes Then Call Shell("explorer.exe " & Chr(34) & CurDir & "\" & FldrName & Chr(34), 1)
        End If
    End If
    
End Sub

By the way, Credit for this goes to a guy in Hungary (Jimmy The Hand), on another forum I work in. He worked out all the code, and listened to what my delima was.

Take care,