[AccessD] AccessD Digest, Vol 38, Issue 45

David Beckles becklesd at tiscali.co.uk
Sun Apr 30 11:59:29 CDT 2006


Hi!
You could try the Windows API:

Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal
lpPath As String) As Long

Then the call
    MakeSureDirectoryPathExists "C:\Files\Excel\Scaleup10\"

will create the entire thing if necessary, but make sure that the path
ends with a backslash.  I have only ever had it fail if the drive did
not exist or the user did not have the necessary permissions.

Hope that this helps,
David

------------Original Message-------------------------------------
> From: MartyConnelly <martyconnelly at shaw.ca>
> Subject: Re: [AccessD] Make Folder Problem
> To: Access Developers discussion and problem solving
> 	<accessd at databaseadvisors.com>
> Message-ID: <44526E04.6070902 at shaw.ca>
> Content-Type: text/plain; charset=us-ascii; format=flowed
>
>  "Run-time error '76' Path Not found error".
> Some part of the path doesn't exist.
>
> I use Dir to create this type of directory structure.
> For example I have three fields in a table each
> one being a seperate directory level
> So you have to walk down the path creating each level
> Now Dir has a problem especially with deletes
>
> The Dir function may hold an OS lock on the directory even after Access has
> been terminated. To get around this point the DIR function at a directory,
> you dont want to delete. Play around with code below to prove the point.
> So you may want to use FSO instead
>
> Also look at last routine to check for invalid DOS characters in path
>
>
> '**************************************
> ' Name: CreateDirectoryStruct
> ' Description:Creates all non-existing
> '   folders in a path. Local or network UNC path.
> ' By: Bill Jones
> '
> ' Inputs:CreateThisPath as string
> '
>
> 'CreateDirectoryStruct("c:\temp\b\a")
>
>  Sub CreateDirectoryStruct(CreateThisPath As String)
>
>     'do initial check
>     Dim ret As Boolean, temp$, ComputerName As String, IntoItCount As 
> Integer, X%, _
>               WakeString As String
>     Dim MadeIt As Integer
>     If Dir$(CreateThisPath, vbDirectory) <> "" Then Exit Sub
>     'is this a network path?
>
>     If Left$(CreateThisPath, 2) = "\\" Then ' this is a UNC NetworkPath
>         'must extract the machine name first, th
>         '     en get to the first folder
>         IntoItCount = 3
>         ComputerName = Mid$(CreateThisPath, IntoItCount, 
> InStr(IntoItCount, _
>                  CreateThisPath, "\") - IntoItCount)
>         IntoItCount = IntoItCount + Len(ComputerName) + 1
>         IntoItCount = InStr(IntoItCount, CreateThisPath, "\") + 1
>         'temp = Mid$(CreateThisPath, IntoItCount
>         '     , x)
>     Else ' this is a regular path
>         IntoItCount = 4
>     End If
>
>     WakeString = Left$(CreateThisPath, IntoItCount - 1)
>     'start a loop through the CreateThisPath
>     '     string
>
>     Do
>         X = InStr(IntoItCount, CreateThisPath, "\")
>
>
>         If X <> 0 Then
>             X = X - IntoItCount
>             temp = Mid$(CreateThisPath, IntoItCount, X)
>         Else
>             temp = Mid$(CreateThisPath, IntoItCount)
>         End If
>
>         IntoItCount = IntoItCount + Len(temp) + 1
>         temp = WakeString + temp
>         'Create a directory if it doesn't alread
>         '     y exist
>         ret = (Dir$(temp, vbDirectory) <> "")
>         If Not ret Then
>             'ret& = CreateDirectory(temp, Security)
>             Debug.Print "MD=" & temp
>             MkDir temp
>         End If
>
>         IntoItCount = IntoItCount 'track where we are in the String
>         WakeString = Left$(CreateThisPath, IntoItCount - 1)
>     Loop While WakeString <> CreateThisPath
>
> End Sub
>
> Function NameFix(NameIn As String) As String
> ' replaces illegal character with underscore
> ' for illegal filenames in windows dos
>    Const ILLEGAL_CHARACTERS = "/\:*?<>|"""
>    ' = /\:*?<>|"
>    Dim i As Integer
>    Dim iTmp As Integer
>    Dim NameFixTemp As Variant
>    'replace illegal filename character with an underscore
>    NameFixTemp = NameIn
>
>    For i = 1 To Len(ILLEGAL_CHARACTERS)
>     NameFixTemp = Replace(NameFixTemp, Mid$(ILLEGAL_CHARACTERS, i, 1), "_")
>      ' iTmp = InStr(1, NameFix, Mid$(ILLEGAL_CHARACTERS, i, 1))
>      ' If iTmp > 0 Then
>      '    Mid$(NameFix, iTmp, 1) = "_"
>      ' End If
>    Next
>    'non ascii printing characters
>   ' Just realized this code will also replace spaces with
>   'underscores.
> 'to accept spaces, change
> '>       If iTmp < 33 Or iTmp > 126 Then to
> '>       If iTmp < 32 Or iTmp > 126 Then
>
>    For i = 1 To Len(NameFixTemp)
>       iTmp = Asc(Mid$(NameFixTemp, i, 1))
>       If iTmp < 32 Or iTmp > 126 Then
>          Mid$(NameFixTemp, i, 1) = "_"
>       End If
>    Next
>    NameFix = NameFixTemp
> End Function
>
>
>
> Kaup, Chester wrote:
>
>   
>> When I try the following I get a runtime error 76
>>
>> If Not fso.folderexists(ResultsPath2) Then
>>    fso.CreateFolder ("C:\Files1\Excel1\Scaleup1")
>> End If
>>
>> -----Original Message-----
>> From: accessd-bounces at databaseadvisors.com
>> [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Jim Moss
>> Sent: Friday, April 28, 2006 11:06 AM
>> To: Access Developers discussion and problem solving
>> Subject: Re: [AccessD] Make Folder Problem
>>
>> Chester,
>>
>> I use the fso.CreateFolder("C:\Accounts Payable\Processed") and it
>> creates
>> sub folders just fine.
>>
>> Jim
>>
>>  
>>
>>     
>>> I use the following code on my machine to create a folder and it works
>>> fine. Just tried it on another users machine and got a message could
>>>    
>>>
>>>       
>> not
>>  
>>
>>     
>>> create folder. I was able to do it manually. Any thoughts?
>>>
>>>
>>>
>>> ChDrive "C:"
>>>
>>> Set fso = CreateObject("Scripting.FileSystemObject")
>>>
>>> ResultsPath = "C:\Files\Excel\Scaleup10"
>>>
>>>
>>>
>>> If Not fso.folderexists(ResultsPath) Then
>>>
>>>    MkDir "C:\Files\Excel\Scaleup10"
>>>
>>> End If
>>>
>>>
>>>
>>> Chester Kaup
>>>
>>> Engineering Technician
>>>
>>> Kinder Morgan CO2 Company, LLP
>>>
>>> Office (432) 688-3797
>>>
>>> FAX (432) 688-3799
>>>
>>>
>>>
>>>
>>>
>>> No trees were killed in the sending of this message. However a large
>>> number of electrons were terribly inconvenienced.
>>>
>>>
>>>
>>> --
>>> AccessD mailing list
>>> AccessD at databaseadvisors.com
>>> http://databaseadvisors.com/mailman/listinfo/accessd
>>> Website: http://www.databaseadvisors.com
>>>
>>>    
>>>
>>>       
>>  
>>
>>     
>
>   


-- 
David Beckles





More information about the AccessD mailing list