Results 1 to 15 of 15
  1. #1
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Be sure the dir existis... (2000 sr-1)

    This a part of code...
    Is possible to ceck if the dir on code are present and if not make automaticlly...?
    Sub TRAPFILE()
    Do Until RunUpdateChk = True
    DoEvents
    Loop
    'Inserire qui la macro successiva al controllo della stampa terminata...
    Call IMPORT_L0785

    End Sub
    Function RunUpdateChk() As Boolean
    If IsFileUpdated("C:EPFL0785.EPF") Then
    If IsFileLock("C:EPFL0785.EPF", "C:EPFBK") Then
    Else
    RunUpdateChk = True
    End If
    End If
    End Function
    Function IsFileUpdated(strFilePath$) As Boolean
    Dim fs As New FileSystemObject, fil As file
    Set fil = fs.GetFile(strFilePath)
    If DateValue(fil.DateCreated) = Date Then IsFileUpdated = True
    End Function
    Function IsFileLock(strFilePath$, strTmpPath$) As Boolean
    Dim fs As New FileSystemObject
    Dim fil As file, strTmp$
    Set fil = fs.GetFile(strFilePath)
    strTmp = fil.Path
    On Error Resume Next
    fil.Move strTmpPath
    If Err <> 0 Then IsFileLock = True
    fil.Move strTmp
    End Function

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    Which directory?

  3. #3
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    FileSystemObject has methods FolderExists and CreateFolder:

    If fs.FolderExists(strTmpPath) = False Then
    fs.CreateFolder strTmpPath
    End If

  4. #4
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    C:EPF
    C:EPFBK

  5. #5
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    Try this:

    1) Add the following procedure to the module:

    Sub CheckFolder(strPath As String)
    Dim fso As New FileSystemObject
    If fso.FolderExists(strPath) = False Then
    fso.CreateFolder strPath
    End If
    Set fso = Nothing
    End Sub

    2) Add the following lines in your code where you want to test if the folders exist:

    CheckFolder "C:EPF"
    CheckFolder "C:EPFBK"

  6. #6
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    Look here please, work but not sure for code:

    Sub TRAPFILE()
    Do Until RunUpdateChk = True
    DoEvents
    Loop
    'Inserire qui la macro successiva al controllo della stampa terminata...
    Call IMPORT_L0785

    End Sub
    Function RunUpdateChk() As Boolean
    'CHECK IF EXISTIS DIR
    CheckFolder "C:EPF"
    CheckFolder "C:EPFBK"
    'CHECK IF EXISTIS DIR

    If IsFileUpdated("C:EPFL0785.EPF") Then
    If IsFileLock("C:EPFL0785.EPF", "C:EPFBK") Then
    Else
    RunUpdateChk = True
    End If
    End If
    End Function
    Function IsFileUpdated(strFilePath$) As Boolean
    Dim fs As New FileSystemObject, fil As file
    Set fil = fs.GetFile(strFilePath)
    If DateValue(fil.DateCreated) = Date Then IsFileUpdated = True
    End Function
    Function IsFileLock(strFilePath$, strTmpPath$) As Boolean
    Dim fs As New FileSystemObject
    Dim fil As file, strTmp$
    Set fil = fs.GetFile(strFilePath)
    strTmp = fil.Path
    On Error Resume Next
    fil.Move strTmpPath
    If Err <> 0 Then IsFileLock = True
    fil.Move strTmp
    End Function
    Sub CheckFolder(strPath As String)
    Dim fso As New FileSystemObject
    If fso.FolderExists(strPath) = False Then
    fso.CreateFolder strPath
    End If
    Set fso = Nothing
    End Sub

  7. #7
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    That should be alright.

  8. #8
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    tks "teacher".
    Sal.

  9. #9
    Star Lounger
    Join Date
    Apr 2002
    Location
    Sydney, New South Wales, Australia
    Posts
    86
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    Is there something else that must be included or defined other than the below code.
    (I am using excel97)I am not able to get it to work

    Sub test()
    Checkfolder "C:TestFolder"
    End Sub

    Sub Checkfolder(strPath As String)
    Dim fso As New FileSystemObject
    If fso.folderExists(strPath) = False Then
    fso.createfolder strPath
    End If
    Set fso = Nothing
    End Sub

    When I tried this I got a
    <img src=/S/exclamation.gif border=0 alt=exclamation width=15 height=15> Compile error:
    User-defined type not defined

    with the code stopping at
    Dim fso As New FileSystemObject

  10. #10
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    You must select Tools | References... (in the Visual Basic Editor), locate Microsoft Scripting Runtime in the list, tick its check box and click OK.

  11. #11
    Star Lounger
    Join Date
    Apr 2002
    Location
    Sydney, New South Wales, Australia
    Posts
    86
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    Thank you Hans

  12. #12
    Silver Lounger
    Join Date
    Dec 2000
    Location
    California, USA
    Posts
    1,758
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    Hans,

    I find your suggested code quite handy. It works just fine with the root directory and subfolder such as "C:TestFolder".

    How would one control the creation of a new folder if a path never existed such as "C:TestFolderFolder01Folder02". Both Folder01 and Folder02 do not exist.

    Is there an efficient way to test say on "C:TestFolderFolder01" and then "C:TestFolderFolder01Folder02"? Think of it this way, if the EndUser enters in the complete path. The code would do the check on the folder and create it when necessary.

    I understand that one can specify two additional lines of code but that would mean the code would have to be modified manually for each sub-folder. I'm looking for a solution that is based on entering in the full path and the code does the work without a manual process.

    CheckFolder(C:TestFolderFolder01)
    CheckFolder(C:TestFolderFolder01Folder02)


    Regards,
    John

  13. #13
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    This version should check each part of the path and create it if necessary:

    Sub CheckFolder(strPath As String)
    Dim fso As Object
    Dim intPos As Integer
    Dim intLen As Integer
    intLen = Len(strPath)
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Left(strPath, 2) = "" Then
    ' UNC path - skip server and share
    intPos = InStr(3, strPath, "")
    intPos = InStr(intPos + 1, strPath, "")
    Else
    ' drive letter - skip C: part
    intPos = 3
    End If
    Do
    intPos = InStr(intPos + 1, strPath, "")
    If intPos = 0 Then
    intPos = intLen + 1
    End If
    If fso.FolderExists(Left(strPath, intPos - 1)) = False Then
    fso.CreateFolder Left(strPath, intPos - 1)
    End If
    Loop Until intPos = intLen + 1
    Set fso = Nothing
    End Sub

    Note: the code should work both for a path with a drive letter, e.g.

    G:TopFolderSubFolder

    and for a UNC path, e.g.

    MyServerMyShareTopFolderSubFolder

    but I haven't actually tested it on a UNC path (I'm on a standalone PC at the moment).

  14. #14
    Silver Lounger
    Join Date
    Dec 2000
    Location
    California, USA
    Posts
    1,758
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    Hans,

    Both sections of code work quite nicely. The UNC worked without an issue.

    Many thanks,
    John

  15. #15
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Be sure the dir existis... (2000 sr-1)

    Thanks for the confirmation.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •