'*****************************************
'参数：SourceFileDir-Excel源文件所在目录
' SourceFileName - Excel源文件名称(含后缀)
' TargetFileDir - Excel文件另存的目录(若另存在源文件目录下,则参数传入空"")
' NewFileName - Excel文件另存为的文件名
'返回值：无
'调用方法：Call SaveAsExcelFile(SourceFileDir,SourceFileName,TargetFileDir,NewFileName)
'*****************************************
Function SaveAsExcelFile(SourceFileDir,SourceFileName,TargetFileDir,NewFileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If Right(Trim(SourceFileDir),1)= "\" Then
SourceFileDir = Left(Trim(SourceFileDir),Len(Trim(SourceFileDir))-1)
End If
SourceFile = Trim(SourceFileDir) & "\" & Trim(SourceFileName)
If fso.FileExists(SourceFile) Then
Set Excel = CreateObject("Excel.Application")
Set WorkBook = oExcel.Workbooks.Open(SourceFile)
If Trim(TargetFileDir)="" Then
TargetFileDir = Trim(SourceFileDir)
Else
TargetFileDir = Trim(TargetFileDir)
End If
TargetFile = Trim(TargetFileDir) & "\" & Trim(NewFileName)
If FSO.FileExists(TargetFile) Then
Ret = MsgBox("文件名" & TargetFile & "已存在,是否覆盖已有文件",vbYesNo)
If Ret = 6 Then
FSO.DeleteFile TargetFile,True
oWorkBook.SaveAs TargetFile
End If
Else
oWorkBook.SaveAs TargetFile
End If
oWorkBook.Close
oExcel.Quit
Set WorkBook = Nothing
Set Excel = Nothing
Else
MsgBox "源文件" & SourceFile & ",不存在"
End If
Set FSO = Nothing
End Function
