复制二进制文件夹文件

• 下载源代码文件 - 2 Kb

引言

我需要一种快速的方法来复制我的图像文件夹。

只需使用：WriteFolder txtSRCPATH, txtDESTPATH

Option Explicit

Private Sub Form_Load()

End Sub

Private Sub cmdCOPY_Click()
    WriteFolder txtSRCPATH, txtDESTPATH
End Sub
Sub WriteFolder(ByVal fsrc As String, ByVal fdes As String)

Dim Buffer() As Byte
Dim fname As String

    fname = Dir(fsrc, vbArchive)

    Do While fname <> ""
    DoEvents
        If (InStr(1, fname, "jpeg", vbBinaryCompare) > 0 
              Or InStr(1, fname, "gif", vbBinaryCompare) > 0) Then
            DoEvents
            WriteFile fdes & fname, ReadFile(fsrc & fname, Buffer())
        End If
        DoEvents
        
        fname = Dir()
        DoEvents
    Loop

End Sub


Function ReadFile(fname As String, Buffer() As Byte) As Byte()

Dim fh, flen As Long

    fh = FreeFile
    Open fname For Binary Access Read As #fh
    flen = LOF(fh)
    Buffer = InputB(flen, #fh)
    Close #fh

ReadFile = Buffer()

End Function
Sub WriteFile(fname As String, Buffer() As Byte)

Dim fh As Long

    fh = FreeFile
    Open fname For Binary Access Write As #fh
    Put #fh, , Buffer
    Close #fh

End Sub

WriteFolder 方法仅传递 "jpeg" 和 "gif" 文件。（您可以根据需要更改此设置。）