Question

我想从源文件夹中复制所有.xlsx文件，并通过附加＆＃34; _Report＆＃34;重命名。（vb脚本代码）我使用以下代码：

objFSO.CopyFile srcpath&"*.xlsx",destpath&"*_Report.xlsx",True

但它不起作用。有人可以帮帮我吗？

Answer 1

试试这个剧本：

Option Explicit
Dim File,SourceFolder,DestinationFolder,Ws
SourceFolder = Browse4Folder()
DestinationFolder = SourceFolder & "\NewFolder"
Call BuildFullPath(DestinationFolder)
Call Scan4Folder(SourceFolder)
MsgBox "The script is finished by Hackoo !",VbInformation,"The script is finished by Hackoo !"
Set Ws = CreateObject("wscript.shell")
ws.run "Explorer " & DblQuote(DestinationFolder)
'**************************************************************************
Function Browse4Folder()
    Dim objShell,objFolder,Message
    Message = "Please select a folder "
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0,Message,0,0)
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Browse4Folder = objFolder.self.path
End Function
'*********************************************************************
Function Scan4Folder(Folder)
    Dim fso,objFolder,File
    Dim Tab,aFile,NewFileName
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(Folder)
    For Each File in objFolder.Files
        NewFileName = GetNewName(File)
        If UCase(fso.GetExtensionName(File)) = "XLSX" or  UCase(fso.GetExtensionName(File)) = "XLS" Then
            Msgbox "The File " & DblQuote(File) & " is copied on " & vbcr &_
            DblQuote(DestinationFolder & "\" & NewFileName),vbInformation,DblQuote(File)
            fso.CopyFile File,DestinationFolder & "\" & NewFileName         
        End If  
    Next
End Function
'*********************************************************************
Sub BuildFullPath(ByVal FullPath)
    Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(FullPath) Then
        BuildFullPath fso.GetParentFolderName(FullPath)
        fso.CreateFolder FullPath
    End If
End Sub
'*********************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'*********************************************************************
Function GetNewName(sFile)
    Dim fso,snamebase,AppendName,Ext
    set fso = CreateObject("Scripting.FileSystemObject")
    snamebase = Split(Right(sFile, Len(sFile) - InStrRev(sFile,"\")),".")(0)
    AppendName = "_Report"
    Ext = fso.GetExtensionName(sFile)
    GetNewName = snamebase & AppendName & "." & Ext 
End Function
'******************************************************************************

Answer 2

请阅读FSO.CopyFile的文档。

它表示在目的地路径

不允许使用通配符。

从源文件夹复制所有.xlsx文件，并通过附加＆＃34; _Report＆＃34;

2 个答案: