Create a folder into a network location

[charly.csh]

Hello everyone,




I have a form called "Main1" and into this several fields, but on this case the most important is the field "Code_Id" (Textbox) and it has a unique ID

I would like to create into a network location a folder named as the field "Code_Id" and I would like that it would be created once I perform a click on the buttom "Createcmd"


Example:

Into the form "Main"

Code_Id = ASDF-001

After clicking on Createcmd

Create a folder located on

C:\Users\General\Desktop


The idea....

C:\Users\General\Desktop\ASD-001


I hope somebody can help me how to create that, it would be really appreciated the help!!!

Thanks

[JoeM]

Here is some code that should do that. It borrows a new User Defined Functions from Allen Browne's site (see: http://allenbrowne.com/func-11.html).

Private Sub Createcmd_Click()

    Dim startPath As String
    Dim finalPath As String
    
'   Enter starting path prefix
    startPath = "C:\Users\General\Desktop"

'   Check to see if Code_Id entered
    If IsNull(Me.Code_Id) Then
        MsgBox "No Code ID entered"
    Else
'   Build final path string
        finalPath = TrailingSlash(startPath) & Me.Code_Id
'   Check to see if folder already exists
        If FolderExists(finalPath) Then
            MsgBox "The following path already exists:" & vbCrLf & finalPath
        Else
'   If not, create it
            On Error GoTo err_check
            MkDir finalPath
            MsgBox "Successfully created folder: " & vbCrLf & finalPath
            On Error GoTo 0
        End If
    End If
    
    Exit Sub
    
'   Error message to return if folder name is not valid
err_check:
    MsgBox finalPath & " is not a valid folder name."
    
End Sub

Function FolderExists(strPath As String) As Boolean
'   From http://allenbrowne.com/func-11.html
    On Error Resume Next
    FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
End Function

Function TrailingSlash(varIn As Variant) As String
'   From http://allenbrowne.com/func-11.html
    If Len(varIn) > 0 Then
        If Right(varIn, 1) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function

[charly.csh]

Wow!!!

This is exactly what I was searching!!!

Thank you very much for the help!!

[JoeM]

You are most welcome! Glad to help

The actual code to make a new directory is fairly short (really, just building the string and using MkDir). I just added in a whole bunch of error checks, like making sure that they made an entry, the folder doesn't already exist, the folder name is valid, etc.

[charly.csh]

it's a fantastic solution JoeM!!

Do you happen to know, the next.... based on the same of course...

I would like to add some files to this pre-defined location (new folder created)


I meant:

1. Create a buttom named "Addfilescmd"
2. Define an Event Addfilescmd_Onclick
3. Open any directory (I have the code to do this....)

4 Instead (on my code) just to copy the root directory, I would like to copy the file and locate this one into the new location created

Please see the code:


Module:

************************************************** ******************************
Option Compare Database
Option Explicit
Function EscogeFichero(Tipo As Integer) As String

'Se declaran las variables'

Dim wzhwndOwner As Long
Dim wzAppName As String
Dim wzDlgTitle As String
Dim wzOpenTitle As String
Dim wzFile As String
Dim wzInitialDir As String
Dim wzFilter As String
Dim wzFilterIndex As Long
Dim wzView As Long
Dim wzflags As Long
Dim wzfOpen As Boolean
Dim Ret As Long

'En caso de error ir al siguiente caso'


On Error GoTo EscogeFichero_Err
WizHook.Key = 51488399

wzhwndOwner = 0&
wzAppName = ""
If Tipo = 1 Then
wzDlgTitle = "Escoge fichero para guardar"
Else
wzDlgTitle = "Escoja fichero gráfico (Jpj,Gif etc) como fondo del Email"
End If
wzOpenTitle = "Escoja fichero"
wzFile = String(255, Chr(0))
wzInitialDir = CurrentProject.Path & "\"

If Tipo = 1 Then
wzFilter = "Cualquier fichero " _
& "(*.*)"
Else
wzFilter = "Fichero Gráfico " _
& "(*.jpg;*.gif;*.bmp)"
End If
wzFilterIndex = 1
wzView = 1
wzflags = 64
wzfOpen = True


Ret = WizHook.GetFileName(wzhwndOwner, _
wzAppName, wzDlgTitle, wzOpenTitle, wzFile, _
wzInitialDir, wzFilter, wzFilterIndex, _
wzView, wzflags, wzfOpen)

If Ret <> -302 Then
EscogeFichero = wzFile
Else
EscogeFichero = ""
End If


EscogeFichero_Exit:
Exit Function


EscogeFichero_Err:


MsgBox "Error nº " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
"en procedimiento EscogeFichero de Módulo EscogeFichero", vbCritical, "Aviso de error"
Resume EscogeFichero_Exit

End Function

************************************************** ****************************

And into the form a buttom named "Problemsupportcmd"

Me.Problemsupporttxt = EscogeFichero(1) '1 es para cualquier tipo de ficheros
CmdOpen_Click_Exit:
Exit Sub


CmdOpen_Click_Err:
MsgBox "Error nº " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
"en procedimiento CmdOpen_Click de Documento VBA Form_FrmMensaje", vbCritical, "Aviso de error"
Resume CmdOpen_Click_Exit

************************************************** **********************

Basically I want to create the attachment option but related to new folder that you help me to create

[JoeM]

Typically, it is best to post brand new questions to new threads, so that they appear as new unanswered questions. Otherwise, most people will "miss" seeing this new question, since it will not show up in the "Unanswered Questions" listing, which returns all threads with no replies to them.

Looks like homework problem, eh?

[charly.csh]

You are fully right!! and I did it

I hope you can also contribute to this

https://www.accessforums.net/access/...fic-56784.html

Thanks!!!!

[JoeM]

I'm a little wrapped up in some projects right now, but hopefully someone else should be able to help.