ERLANDSEN DATA CONSULTING Excel & VBA Tips   Information in English / Informasjon på engelsk

 

Disse websidene oppdateres ikke lengre og er kun tilgjengelig for historikken sin skyld.

Klikk her for å gå til den oppdaterte informasjonen.

Opprette nye mapper

Ved hjelp av funksjonen nedenfor kan man sjekke om en mappe finnes og eventuelt opprette manglende mapper:

Function FolderExists(strInputFolder As String, blnCreate As Boolean) As Boolean
' returnerer Sann dersom mappen finnes, kan opprette manglende mapper
' eksempel: If Not FolderExists("C:\FolderName\SubFolder", False) Then Exit Sub
' eksempel: If Not FolderExists("C:\FolderName\NewFolder", True) Then Exit Sub
Dim strFolder As String, varrFolders As Variant, i As Long
    FolderExists = False
    ' validate input
    If InStr(1, strInputFolder, ":", vbBinaryCompare) <> 2 Then Exit Function
    If InStr(1, strInputFolder, "\", vbBinaryCompare) = 0 Then Exit Function
    If blnCreate Then ' try to create any missing folders
        ' split path into separate folders
        varrFolders = Split(strInputFolder, "\", -1, vbBinaryCompare)
        strFolder = varrFolders(LBound(varrFolders)) ' drive letter
        For i = LBound(varrFolders) + 1 To UBound(varrFolders)
            strFolder = strFolder & "\" & varrFolders(i) ' add folder to path
            If Not Len(Dir(strFolder, vbDirectory)) > 0 Then
                On Error Resume Next
                MkDir strFolder ' create new folder
                On Error GoTo 0
            End If
        Next i
        Erase varrFolders
        ' check and see if the folder exists
        FolderExists = Len(Dir(strFolder, vbDirectory)) > 0
    Else ' just check and see if the folder exists
        FolderExists = Len(Dir(strInputFolder, vbDirectory)) > 0
    End If
End Function

 

Dokumentet er sist oppdatert 2005-04-26 10:49:54

 

 
Erlandsen Data Consulting     http://www.erlandsendata.no/   
Excel & VBA Tips   Copyright ©1999-2024    Ole P. Erlandsen   All rights reserved
E-post kontaktadresse