无法重命名excel文件



我正在将内容从一个excel复制到另一个excel,并删除源excel工作表。删除源excel工作表后,我将该文件重命名为原始名称。但是,替换不起作用。不确定,我哪里做错了。这是代码。

'getting the file
filePath = BrowseForFile() 
Const xlUp = -4162
Set objExcel = CreateObject("Excel.Application")
fileName = Mid(filePath, InStrRev(filePath, "") + 1)
MsgBox "filepath is --->" & filepath
MsgBox "selected filename is --->" & fileName
newPath = CStr(Left(filePath, InStrRev(filePath, "")))
MsgBox "newpath is --->" & newPath
newname = newPath & "temp_" & fileName
MsgBox "new file name is i.e., newname ----->" & newname
Set objWorkbook = objExcel.Workbooks.Add 
objWorkbook.SaveAs(newname)  
Set objWorkbook1= objExcel.Workbooks.Open(filePath)
Set objWorkbook2= objExcel.Workbooks.Open(newname)
objWorkbook1.Worksheets("Sheet1").UsedRange.Copy
objWorkbook2.Worksheets("Sheet1").Range("A1").PasteSpecial -4163
objWorkbook1.save
objWorkbook2.save
objWorkbook1.close
objWorkbook2.close
Set objFSO = CreateObject("Scripting.FileSystemObject")
if objFSO.FileExists(filePath) Then  
MsgBox "inside delete file condition"
objFSO.DeleteFile filePath
else
MsgBox "No file"
End If
MsgBox "newname filename before renaming it--------" & newname  
' renaming the file to original
newfileName = Replace(newname, "temp_","")
MsgBox "file after renaming is i.e., newfileName ------>" &   newfileName
MsgBox "fileName is i.e., fileName-------------->" & fileName
MsgBox "fileName for final processing is ------>" & newfileName
WScript.Sleep 10000  
Set objWorkbook3= objExcel.Workbooks.Open(newfileName)  
Set ThisSheet = objWorkbook3.ActiveSheet

将新文件保存为"temp1"或您喜欢的任何文件,关闭并删除原始文件,然后将"temp1"重命名为您想要的名称。

最新更新