复制文件夹，子文件夹&包含来自VB6的文件 [英] Copy Folder, sub-Folder & contain of files From VB6

问题描述

最近提供的代码(Shell("xcopy/S源目标，vbMaximizedFocus)未复制我的项目..
我再次发送相同的零钱编码.

请给我正确的vb6代码..

我想通过VB6语言将文件夹，子文件夹及其包含的文件从一个位置(C:\ Program Files \ Common Files \ Common \ MNCP)复制到另一位置(C:\ Program Files \ MNCPSetup).

注意:复制(MNCP)文件夹包含子文件夹和许多文件.

我该如何解决这个问题???
请尽快给我发送正确的vb6编码.....
我等待答案....

Recent supplying code(Shell("xcopy /S source destination,vbMaximizedFocus) is not copy my project..
Again i send same little change coding.

Please send me proper vb6 code..

I want to copy of Folder, Sub-Folder & their contain of files from one location(C:\Program Files\Common Files\Common\MNCP) to another location(C:\Program Files\MNCPSetup) by VB6 language.

Note : Copying(MNCP) Folder have contain sub-folder & many files.

How can i solve this problem????
Please Send me proper vb6 coding as early as possible.....
I wait for answer....

推荐答案

最简单的方法:
Shell("xcopy/S源目标"，vbMaximizedFocus)

最好的问候
Espen Harlinn

The simplest way:
Shell("xcopy /S source destination", vbMaximizedFocus)

Best regards
Espen Harlinn

这是我的代码，用于将subforder子文件夹中的文件复制到新文件夹中

Here is my code to copy file in sub of subforder into new folder

Option Explicit
Public Arr() As String
Public Counter As Long

Sub LoopThroughFilePaths()
    Dim j As Long
    Dim MyFile As String
    Dim strSource As String
    Dim strDest As String
    strSource = "S:\ACC\ACC Common share\New\Original Data from System\CIC Original"
    strDest = "S:\ACC\ACC Common share\New\ACC-Report in Vietnam\CIC\Monthly_Credit Infor\CIC Report"
    ReDim Arr(0)
    Counter = 0
    Arr(0) = strSource
    Arr = GetSubFolders(strSource)
    'Application.ScreenUpdating = False
    'Application.DisplayAlerts = False

    For j = LBound(Arr) To UBound(Arr)
        Call XcopyFiles(Arr(j) & "\CREDIT_INFO_*.XLS", strDest)
    Next j
End Sub

Function GetSubFolders(RootPath As String)
    Dim fso As Object
    Dim fld As Object
    Dim sf As Object
    Dim myArr
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(RootPath)
    For Each sf In fld.subfolders
        Counter = Counter + 1
        ReDim Preserve Arr(Counter)
        Arr(Counter) = sf.Path
        myArr = GetSubFolders(sf.Path)
    Next
    GetSubFolders = Arr
    Set sf = Nothing: Set fld = Nothing: Set fso = Nothing
End Function

Sub XcopyFiles(strSource, strDestination)
Dim wsh As Object
    Set wsh = CreateObject("wscript.shell")
    wsh.Run "xcopy.exe """ & strSource & """ """ & strDestination & """ /y /r", 1, True
    'Application.ScreenUpdating = False
    'Application.DisplayAlerts = False
    Set wsh = Nothing
End Sub

这篇关于复制文件夹，子文件夹&包含来自VB6的文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！