复制带有进度条的文件绕过文件替换确认

时间:2019-05-30 19:14:50

标签: vba progress-bar

这是此问题和很好答案的跟进:

Copy files with progress bar

因此,我从Siddharth Rout的答案中添加了代码,它确实做了我想发生的事情,但有一个小异常。当我复制文件时,我遍历目录中的每个文件并向上复制它,只要它不是* List.xml。因为我要替换现有的库,所以97%的文档是预先存在的,每次都会提示我替换现有的文档。

是否有一种方法可以提示我选择替换所有文件?我需要重新格式化/构造代码序列吗?

Function UploadToSharepoint(Folderpath As String, Foldername As String, Filenames() As String, SharepointLinks() As String) As Boolean

    'upload file to sharepoint library based on the folder name
    Dim SharePointLib As String
    Dim LocalAddress As String
    Dim DestinationAddress As String
    Dim xCounter As Long

    On Error GoTo loadFailed

Pickafolder:

    Folderpath = FolderPick

    Foldername = Left(Folderpath, Len(Folderpath) - 1)
    Foldername = RIght(Foldername, Len(Foldername) - InStrRev(Foldername, "\"))

    Select Case Foldername
        Case "OPSS", "SSP", "OPSD", "MTOD", "SSD"

            SharePointLib = "\\my.company.com\Subsite\" & Foldername & "\"

        Case "West", "Eastern", "Northeastern", "Northwestern", "Head Office"

            SharePointLib = "\\my.company.com\Subsite\NSP\" & Foldername & "\"

        Case "NSP", "NSSP"

            MsgBox "Pick the NSP regional sub folder:  West, Eastern, Northeastern, Northwestern, Head Office"
            GoTo Pickafolder

        Case Else

            MsgBox "Inappropriate directory to upload from. Please select one of the CPS download directories"
            GoTo Pickafolder

     End Select

    Filenames = GetFilesDir(Folderpath)
    ReDim SharepointLinks(LBound(Filenames) To UBound(Filenames))

    For xCounter = LBound(Filenames) To UBound(Filenames)

        LocalAddress = Folderpath & Filenames(xCounter)
        DestinationAddress = SharePointLib & Filenames(xCounter)
'**********************************************************    
        Call VBCopyFolder(LocalAddress, DestinationAddress)
'**********************************************************        
        SharepointLinks(xCounter) = "#http:" & Replace(DestinationAddress, "\", "/") & "#"

    Next xCounter

    UploadToSharepoint = True

    Exit Function

loadFailed:
    UploadToSharepoint = False

End Function

从外观上看,我并没有排除我之前提到的文件……必须在其他地方进行。

更新

根据在链接的问题上收到的评论,解决方案是在开始时声明一个公共常量:

Public Const FOF_NOCONFIRMATION As Long = &H10

然后在复制过程中将代码行更改为:

.fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION

现在,这确实解决了不断被要求确认替换的问题。我对此感到非常高兴。现在的问题是,进度窗口显示要复制的第一个文件,然后消失,但无法重新显示后续文件。其余文件仍然会被复制,并且prg会像预期的那样进行。进度栏的全部目的是让人们知道“事物”仍在后台发生,而现在却没有发生。有什么需要调整的吗?

更新2

运行代码并在网络驱动器而不是本地计算机上选择源目录之后,像我期望的那样,每个单个文件的复制窗口都会弹出。我注意到有时进度条在达到100%之前会关闭。这使我相信,由于文件太小,以至于从本地驱动器复制到共享点时,操作完成得如此之快,以至于没有时间在关闭窗口之前绘制和更新进度窗口。

0 个答案:

没有答案