Kopiere mappe med indhold

'-------------------------------- Module1 --------------------------------
Public Declare Function SHFileOperation Lib _
      "shell32.dll" Alias "SHFileOperationA" _
      (lpFileOp As Any) As Long

Public Declare Sub SHFreeNameMappings Lib _
      "shell32.dll" (ByVal hNameMappings As Long)

Public Declare Sub CopyMemory Lib "KERNEL32" _
      Alias "RtlMoveMemory" (hpvDest As Any, hpvSource _
      As Any, ByVal cbCopy As Long)

Public Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As FO_Functions
        pFrom As String
        pTo As String
        fFlags As FOF_Flags
        fAnyOperationsAborted As Long
        hNameMappings As Long
        lpszProgressTitle As String
End Type

Public Enum FO_Functions
        FO_MOVE = &H1
        FO_COPY = &H2
        FO_DELETE = &H3
        FO_RENAME = &H4
End Enum

Public Enum FOF_Flags
        FOF_MULTIDESTFILES = &H1
        FOF_CONFIRMMOUSE = &H2
        FOF_SILENT = &H4
        FOF_RENAMEONCOLLISION = &H8
        FOF_NOCONFIRMATION = &H10
        FOF_WANTMAPPINGHANDLE = &H20
        FOF_ALLOWUNDO = &H40
        FOF_FILESONLY = &H80
        FOF_SIMPLEPROGRESS = &H100
        FOF_NOCONFIRMMKDIR = &H200
        FOF_NOERRORUI = &H400
        FOF_NOCOPYSECURITYATTRIBS = &H800
        FOF_NORECURSION = &H1000
        FOF_NO_CONNECTED_ELEMENTS = &H2000
        FOF_WANTNUKEWARNING = &H4000
End Enum

Public Type SHNAMEMAPPING
        pszOldPath As String
        pszNewPath As String
        cchOldPath As Long
        cchNewPath As Long
End Type

Public Function SHFileOP(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Dim result As Long
Dim lenFileop As Long
Dim foBuf() As Byte
  lenFileop = LenB(lpFileOp)
    ReDim foBuf(1 To lenFileop)
      Call CopyMemory(foBuf(1), lpFileOp, lenFileop)
      Call CopyMemory(foBuf(19), foBuf(21), 12)
    result = SHFileOperation(foBuf(1))
  SHFileOP = result
End Function


Public Function sCopy(sFile1, sFile2) 'Kopier filer eller mapper
Dim lret As Long
Dim fileop As SHFILEOPSTRUCT
  With fileop
      .hwnd = 0
      .wFunc = FO_COPY
      .pFrom = sFile1
      .pTo = sFile2
      .lpszProgressTitle = "Fra: " & sFile1 & " Til: " & sFile2
      .fFlags = FOF_SIMPLEPROGRESS Or FOF_RENAMEONCOLLISION
  End With
lret = SHFileOP(fileop)
If result <> 0 Then
  MsgBox Err.LastDllError
    Else
  If fileop.fAnyOperationsAborted <> 0 Then
    MsgBox "Operation Failed"
  End If
End If
End Function

Public Function sDelete(sFile) 'Slette filer eller mapper
Dim lret As Long
Dim fileop As SHFILEOPSTRUCT
  With fileop
      .hwnd = 0
      .wFunc = FO_DELETE
      .pFrom = sFile
      .lpszProgressTitle = sFile1
      .fFlags = FOF_SIMPLEPROGRESS Or FOF_ALLOWUNDO
  End With
lret = SHFileOP(fileop)
  If result <> 0 Then
    MsgBox Err.LastDllError
  Else
    If fileop.fAnyOperationsAborted <> 0 Then
      MsgBox "Operation Failed"
    End If
  End If
End Function

Public Function sRename(sFile1, sFile2) 'Omdøbe filer eller mapper
Dim lret As Long
Dim fileop As SHFILEOPSTRUCT
  With fileop
      .hwnd = 0
      .wFunc = FO_RENAME
      .pFrom = sFile1
      .pTo = sFile2
      .lpszProgressTitle = "Fra: " & sFile1 & " Til: " & sFile2
      .fFlags = FOF_SIMPLEPROGRESS Or FOF_ALLOWUNDO
  End With
lret = SHFileOP(fileop)
  If result <> 0 Then
    MsgBox Err.LastDllError
  Else
    If fileop.fAnyOperationsAborted <> 0 Then
      MsgBox "Operation Failed"
    End If
  End If
End Function

Public Function sMove(sFile1, sFile2) 'Flytte filer eller mapper
Dim lret As Long
Dim fileop As SHFILEOPSTRUCT
  With fileop
      .hwnd = 0
      .wFunc = FO_MOVE
      .pFrom = sFile1
      .pTo = sFile2
      .lpszProgressTitle = "Fra: " & sFile1 & " Til: " & sFile2
      .fFlags = FOF_SIMPLEPROGRESS Or FOF_ALLOWUNDO
  End With
lret = SHFileOP(fileop)
  If result <> 0 Then
    MsgBox Err.LastDllError
  Else
    If fileop.fAnyOperationsAborted <> 0 Then
      MsgBox "Operation Failed"
    End If
  End If
End Function
'-------------------------------- Module1 --------------------------------


'--------------------------------- Form1 ---------------------------------

Private Sub Command1_Click()
'sMove "C:\Temp\TestFile.txt", "C:\"
sMove "C:\TestMappe", "C:\Temp"
End Sub

Private Sub Command3_Click()
'sCopy "D:\TestFile.txt", "C:\"
sCopy "F:\*.*", "C:\Temp\Test"
End Sub

Private Sub Command4_Click()
'sDelete "C:\TestFile.txt"
sDelete "C:\TestMappe"
End Sub

Private Sub Command5_Click()
'sRename "C:\Ejay_se.zip", "C:\Ejay_se.zip_"
sRename "C:\TestMappe", "C:\TestMappe2"
End Sub

'-------------------------- hvis du skal kopier flere filer --------------------------
'sCopy "D:\test.htm" & vbNullChar & "D:\test2.htm", "C:\"
'-------------------------- hvis du skal kopier flere filer --------------------------

'--------------------------------- Form1 ---------------------------------

Eller 100 gange simplere - brug FileSystemObject, metoden .CopyFolder :o)

Se http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/jsmthCopyFolder.asp
/Martin

ok, jeg har forsøgt med filesystemobject men kan ikke rigtitg få det til at virke. Er der ikke en der gider lave et lille eksempel med det?

Ikke få det til at virke?

Prøv at vis din kode...

FileSystemObject.CopyFolder "c:\mydocuments\letters\*", "c:\tempfolder\"

Altså - for at få alle detaljerne med:

Gå til Project > References, og afkryds "Microsoft Scripting Runtime" 

  Dim FSO As FileSystemObject
  Set FSO = CreateObject("Scripting.FileSystemObject")
  FileSystemObject.CopyFolder "c:\mydocuments\letters\*", "c:\tempfolder\"
  set FSO = Nothing

Sorry - Ret til
  FSO.CopyFolder "c:\mydocuments\letters\*", "c:\tempfolder\"

Hvis du skal have alle filerne med fra første niveau (dvs. filer placeret i c:\mydocuments\letters\) samt naturligvis alle foldere og filer fra underniveauer, skal du bruge

  Dim FSO As FileSystemObject
  Set FSO = CreateObject("Scripting.FileSystemObject")
  FSO.CopyFolder "c:\mydocuments\letters\*", "c:\tempfolder\"
  FSO.CopyFile "c:\mydocuments\letters\*.*", "c:\tempfolder\"
  set FSO = Nothing

Så skulle den ged være stegt - eller hvad man nu siger!

Tak for hjælpen