Drivelistbox - en haster derfor 100 POINT

Der må være noget galt i din kode. Enten til drivelistboxen eller til copieringen.

Private Sub Command1_Click()
Dim Path As String
Path = App.Path
If Right$(" " & Path, 1) <> "\" Then
' Ser efter at der IKKE er en backslash til slut
    Path = Path & "\"  ' ... og tilføjer den i så fald
End If
Shell "xcopy """ & Path & "da*.*"" """ & Drive1.Drive & "\common\*.*"" /C /I /Y", vbHide
MsgBox "Installation er fuldført - Afslut nu programmet"
End Sub

Jeg har lige prøvet din kode.
Får samme "fejl".

Det skyldes at drive1.drive returnerer f.eks d:[data]
Så du skal lige ind og søge på om der er "[]" i drive1.drive og fjerne det.

//akj

prøv dette:
s_ret = Drive1.Drive

pos1 = InStr(s_ret, "[")
If pos1 > 0 Then
    s_ret = Trim(Left(s_ret, pos1 - 1))
End If

Shell "xcopy """ & Path & "da*.*"" """ & s_ret & "\common\*.*"" /C /I /Y", vbHide

Prøv dette i stedet for bare "drive1.drive":

left$(drive1.Drive,instr(drive1.Drive,":"))

Hvad med at få windows til at gørere det. :-)

'-------------------------------- 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:\ser.htm" & vbNullChar & "D:\test.htm", "C:\"
'-------------------------- hvis du skal kopier flere filer --------------------------

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

Kanon det virker. 1000 tak