استفاده از fso

سلام
من وقتی با fso پوشه ای رو کپی میکنم مشکلی پیش نمیاد اما وقتی میخوام فایلی رو کپی کنم میگه permission denied. به نظر شما باید چکار کنم؟ ممنون.

این ها خوبن؟

کد:

---

Public Function CopyFile(Source As String, Destiny As String, Optional BlockSize As Long = 32765) As Boolean

    '<EhHeader>
    On Error Goto CopyFile_Err
    '</EhHeader>
    Dim Pos As Long
    Dim posicao As Long
    Dim pbyte As String
    Dim buffer As Long
    Dim Exist As String
    Dim LenSource As Long
    Dim FFSource As Integer, FFDestiny As Integer
   
    100 buffer = BlockSize
    102 posicao = 1
    104 Exist = ""
    106 Exist = Dir$(Destiny)
    108 If Exist <> "" Then Kill Destiny
    110 FFSource = FreeFile
    112 Open Source For Binary As #FFSource
    114 FFDestiny = FreeFile
    116 Open Destiny For Binary As #FFDestiny
    118 LenSource = LOF(FFSource)
    120 For Pos = 1 To LenSource Step buffer
    122 If Pos + buffer > LenSource Then buffer = (LenSource - Pos) + 1
    124 pbyte = Space$(buffer)
    126 Get #FFSource, Pos, pbyte
    128 Put #FFDestiny, posicao, pbyte
    130 posicao = posicao + buffer
    '132 RaiseEvent Progress(Round((((Pos /

    ' 100) * 100) / (LenSource / 100)), 2))
    '134 DoEvents
Next

136 Close #FFSource
138 Close #FFDestiny
'140 RaiseEvent CopyComplete
'<EhFooter>
Exit Function
CopyFile_Err:
MsgBox "Um erro inesperado ocorreu!" & vbCrLf & _
"Por favor anote ou copie (Pressionando a tecla 'Print-Screen' e depois CTRL+V no PAINT) os dados abaixo:" & vbCrLf & _
"No Erro: " & Err.Number & vbCrLf & _
"Local: Project1.Form1.CopyFile " & vbCrLf & _
"Linha: " & Erl & vbCrLf & vbCrLf & _
"Descrição: " & Err.Description & vbCrLf & vbCrLf & _
"Operação Cancelada!", vbCritical, "Erro!"
Screen.MousePointer = vbDefault
Resume CopyFile_Sai
CopyFile_Sai:
Exit Function
'</EhFooter>
End Function

---

کد:

---

Dim fso As New FileSystemObject
'The selected drive
Dim strDrive As String
'The folderpath
Dim strFolder As String
'Collection to store the selected filepa

' ths


Private Sub cmbDrives_Click()

    Dim drive As drive
    Dim File As File
    Dim SubFolder As Folder
    Dim i As Integer
    i = 0
    lstFiles.Clear
    If cmbDrives = "" Then Exit Sub
    strDrive = cmbDrives.Text
    strFolder = ""
    Set drive = fso.GetDrive(cmbDrives.Text)

    If drive.IsReady Then

        For Each File In drive.RootFolder.Files
            lstFiles.AddItem File.Name, i
            i = i + 1
        Next

        i = lstFiles.ListCount

        For Each SubFolder In _ drive.RootFolder.SubFolders
            lstFiles.AddItem SubFolder, i
            i = i + 1
        Next

    Else
        MsgBox "Drives Not ready"
    End If

End Sub

'Moves to the parent folder (if any)

Private Sub cmdup_Click()

    Dim Folder As Folder
    Dim File As File
    Dim SubFolder As Folder
    Dim i As Integer
    If strDrive = "" Then Exit Sub
    If strFolder = "" Then Exit Sub
    'Get current folder
    Set Folder = fso.GetFolder(strDrive & _ strFolder)
    'Find parent folder
    strFolder = Left(strFolder, InStrRev _(strFolder, "\") - 1)
    lstFiles.Clear
    'If parent exists

    If Not Folder.ParentFolder Is Nothing Then
        'Add all files in parent

        For Each File In Folder.ParentFolder.Files
            lstFiles.AddItem File.Name, i
            i = i + 1
        Next

        i = lstFiles.ListCount
        'Add all subfolders in parent

        For Each SubFolder In _ Folder.ParentFolder.SubFolders
            lstFiles.AddItem SubFolder, i
            i = i + 1
        Next

    Else 'If it Not has parent

        For Each File In Folder.Files
            lstFiles.AddItem File.Name, i
            i = i + 1
        Next

        i = lstFiles.ListCount

        For Each SubFolder In Folder.SubFolders
            lstFiles.AddItem SubFolder, i
            i = i + 1
        Next

    End If

End Sub


Private Sub Form_Load()

    Dim drive As drive
    Dim i As Integer
    i = 0
    'Add all drives to combo

    For Each drive In fso.Drives
        cmbDrives.AddItem drive.Path, i
        i = i + 1
    Next

End Sub


Private Sub Form_Unload(Cancel As Integer)

    Set fso = Nothing
End Sub


Private Sub lstFiles_Click()

    Dim Folder As Folder
    Dim SubFolder As Folder
    Dim File As File
    Dim i As Integer
    i = 0

    If Not lstFiles.SelCount > 1 Then
        'if its a folder

        If InStr(lstFiles.Text, ":\") Then
            Set Folder = fso.GetFolder _(lstFiles.Text)
            lstFiles.Clear
            strFolder = strFolder & "\" & _ Folder.Name
            'Add all files

            For Each File In Folder.Files
                lstFiles.AddItem File.Name, i
                i = i + 1
            Next

            i = lstFiles.ListCount
            'Add subfolders

            For Each SubFolder In _ Folder.SubFolders
                lstFiles.AddItem SubFolder, i
                i = i + 1
            Next

        End If

    End If

End Sub

---

BEGINNERS GUIDE!

This a beginners guide to VB, this also has a Zip file containing all the projects and the article as a text file. PLEASE VOTE!

کد:

---

http://www.planet-source-code.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=30265&strZipAccessCode=tp%2FB302655501

---

سلام
ممنون
میشه بگی این همه کد برای چیه؟ مگه فرمان ساده ی fso.copyfile نمیتونه این کار رو بکنه؟

همین پست بالایی یه آموزش در مورد fso هست که توش همه چی
پیدا می شه
شما اگه اون رو بخونید می تونید از راه اون کپی کنید.

اون دوتای دیگه هم برنامه هایی هستند که به fso کار می کنن