Oprette mappe hvis den ikke eksistere!

Har du prøvet at droppe den sidste \ ? Både i Dir og MkDir

Næ nu har jeg vist fundet ud af det

Dir("E:\CAD\DWF\dfhgdh\", vbDirectory) henter den første "fil" i mappen dfhgdh som er en mappe, dvs den første undermappe i dfhgdh. Så jeg vil forvente at din kode opretter et nyt dir hvis der ikke findes undermapper i dfhgdh, og det var ikkedet du ville, vel?

Jeg ville bruge FileSystemObject:

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists("E:\CAD\DWF\dfhgdh") then
  MkDir "E:\CAD\DWF\dfhgdh\"
end if
Set fso = Nothing

A = Dir("E:\CAD\DWF\dfhgdh", vbDirectory)
if A = "" then
MkDir "E:\CAD\DWF\dfhgdh\"
End If

A = Dir("E:\CAD\DWF\dfhgdh", vbDirectory)
if A = "" then
MkDir "E:\CAD\DWF\dfhgdh"
End If

fjernet en \

her har du en som kan oprette alle de mapper du vil have på en gang:

' --------------------------------- Form1 ---------------------------------
Option Explicit

Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10

Private Type FILETIME
      dwLowDateTime As Long
      dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
      dwFileAttributes As Long
      ftCreationTime As FILETIME
      ftLastAccessTime As FILETIME
      ftLastWriteTime As FILETIME
      nFileSizeHigh As Long
      nFileSizeLow As Long
      dwReserved0 As Long
      dwReserved1 As Long
      cFileName As String * MAX_PATH
      cAlternate As String * 14
End Type

Private Type SECURITY_ATTRIBUTES
      nLength As Long
      lpSecurityDescriptor As Long
      bInheritHandle As Long
End Type

Private Declare Function FindFirstFile Lib "kernel32" _
                Alias "FindFirstFileA" _
              (ByVal lpFileName As String, _
                lpFindFileData As WIN32_FIND_DATA) As Long
 
Private Declare Function FindClose Lib "kernel32" _
              (ByVal hFindFile As Long) As Long

Private Declare Function CreateDirectory Lib "kernel32" _
                Alias "CreateDirectoryA" _
              (ByVal lpPathName As String, _
                lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long

Private Function QualifyPath(ByVal strFolder As String) As String
  strFolder = Trim$(strFolder)
  If Right$(strFolder, 1) = "\" Then
        QualifyPath = Left$(strFolder, Len(strFolder) - 1)
  Else: QualifyPath = strFolder
  End If
End Function

Public Function FolderExists(ByVal strFolder As String) As Boolean
Dim hFile As Long
Dim WFD As WIN32_FIND_DATA
  strFolder = QualifyPath(strFolder)
  hFile = FindFirstFile(strFolder, WFD)
  FolderExists = (hFile <> INVALID_HANDLE_VALUE) And _
                (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY)
  Call FindClose(hFile)
End Function

Public Function CreateFolder(ByVal strFolder As String) As Boolean
Dim SA As SECURITY_ATTRIBUTES
  strFolder = QualifyPath(strFolder)
  If Not FolderExists(strFolder) Then
    CreateFolder = CreateDirectory(strFolder, SA)
      Else
    CreateFolder = True
  End If
End Function

Public Sub CreateFolders(ByVal strPath As String)
Dim strSlash As Integer
Dim strFolderDir As String
  strSlash = 1
  Do While strSlash > 0
    strSlash = InStr(strSlash + 1, strPath, "\")
    If strSlash > 0 Then
      strFolderDir = Left(strPath, strSlash - 1)
      If Not FolderExists(strFolderDir) Then
        Call CreateFolder(strFolderDir)
      End If
    End If
  Loop
  If Not FolderExists(strPath) Then
    Call CreateFolder(strPath)
  End If
End Sub

Private Sub Form_Load()
  Call CreateFolders("C:\Test\Test2\Test3")
' eller
' Call CreateFolders("C:\Test\Test2\Test3\")
End Sub
' --------------------------------- Form1 ---------------------------------

Nu skyder du vist gråspurve med kanoner, ikke ...

hvad mener du??

du kan da godt få en nemmer udgave hvis du ikke fatter noget at API :D


' --------------------------------- Form1 ---------------------------------
Option Explicit

Public Sub CreateFolders(ByVal strPath As String)
Dim fso As Object
Dim strSlash As Integer
Dim strFolderDir As String

  Set fso = CreateObject("Scripting.FileSystemObject")
  strSlash = 1

  Do While strSlash > 0
    strSlash = InStr(strSlash + 1, strPath, "\")
    If strSlash > 0 Then
      strFolderDir = Left$(strPath, strSlash - 1)
      If Not fso.FolderExists(strFolderDir) Then
        fso.CreateFolder strFolderDir
      End If
    End If
  Loop
  If Not fso.FolderExists(strPath) Then
    fso.CreateFolder strPath
  End If

  Set fso = Nothing
End Sub

Private Sub Form_Load()
  Call CreateFolders("C:\Test\Test2\Test3")
' eller
' Call CreateFolders("C:\Test\Test2\Test3\")
End Sub
' --------------------------------- Form1 ---------------------------------

Hej.

En lille enkel:

Private Sub Command1_Click()
If Len(Dir("f:\abc", vbDirectory)) = 0 Then MkDir "f:\abc"
End Sub

Måske virker den ikke altid, men test selv.

M.v.h.  Jørn

joern > det er altså den samme måde som kabbak har lavet det.. bare uden Len()

sjh>>

Jaja, men jeg har selv dårlige erfaringer med at sammenligne med ingenting: ""
Derfor foreslår jeg at teste på om længden er nul.  Og så bare én linie :-)
Men spørgeren må jo selv vælge blandt svarene.  Spørgsmålet om point er jeg (og vist også du selv) hinsides.  Det er ligegyldigt.

M.v.h.  Jørn

Tak for alle svarene. Jeg vender lige tilbage på mandag når jeg har fået kigget på det igen.

Takker endnu engang, har brugt kabbak's løsning.

Så får du et svar ;-))