怎样给文件重新命名？或改名copy批量文件也可（很急）

Question

我在工作是遇到的，我想在程序中控制文件将批量文件拷贝到另一目录，并改名。文件已经拷贝过去了，但没能改名，我很苦恼，请各位帮个忙，先谢过各位

Answer 1

Sub FileCopy(Source As String, Destination As String)
    Member of VBA.FileSystem
    Copies a fileDestination 设为你要的文件名字Private Sub Command4_Click()
    FileCopy "c:\test.dat", "D:\test.dat"
End Sub

Answer 2

Private Sub Command1_Click()
    rename "c:\test.dat" "c:\testoth.dat"
End Sub

Answer 3

Dim SourceFile, DestinationFile
SourceFile = "SRCFILE"   ' 指定源文件名。
DestinationFile = "DESTFILE"   ' 指定目的文件名。
FileCopy SourceFile, DestinationFile   ' 将源文件的内容复制到目的文件中

Answer 4

Dim OldName, NewName
OldName = "OLDFILE": NewName = "NEWFILE"   ' 定义文件名。
Name OldName As NewName   ' 更改文件名。 
OldName = "C:\MYDIR\OLDFILE": NewName = "C:\YOURDIR\NEWFILE"
Name OldName As NewName   ' 更改文件名，并移动文件。

Answer 5

'***********************************************************
Public Function CopyFolder(strFolderSource, strFolderDest, BlnOverWrite)
On Error Resume Next
Dim fso, lngErr
If Not FolderExist(strFolderDest) Then
      lngErr = CreateFolder(strFolderDest)
      
End If
If lngErr = 0 Then
Set fso = NewFileSystemObject
fso.CopyFolder strFolderSource, strFolderDest, BlnOverWrite
CopyFolder = Err.NumberElse
CopyFolder = lngErr
End If
  Debug.Print "CopyFolder:" & Err.Description
End Function
'***********************************************************
Public Function CopyFolderA(astrFolderSource, astrFolderDest)
On Error Resume Next
Dim fso, lngErr
If Not IsArray(astrFolderSource) Or Not IsArray(astrFolderDest) Then
      lngErr = -1
      CopyFolderA = lngErr
      Debug.Print "CopyFolderA NOT IS ARRAY!"
    Exit Function
End IfDim lngLBSource, lngUBSource, lngLBDest, lngUBDest
Dim lngLoop
'*关键外部调用：GetLBUB
 If GetLBUB(astrFolderSource, lngLBSource, lngUBSource) <> 0 Or _
     GetLBUB(astrFolderDest, lngLBDest, lngUBDest) <> 0 Then
    lngErr = -2
    CopyFolderA = lngErr
    Debug.Print "CopyFolderA.GetLBUB Err"
    Exit Function
 End If
 '1-----X
 '1-----1
 'X-----1
 'X-----X
Dim bln1ToX, blnXTo1, blnXtoX
bln1ToX = (lngUBSource = 0 And lngUBDest <> 0)
blnXTo1 = (lngUBSource <> 0 And lngUBDest = 0)
blnXtoX = (Not bln1ToX And Not blnXTo1)
'***************
'1 To X
If bln1ToX Then
    Debug.Print "CopyFolderA: 1 to X"
     For lngLoop = lngLBDest To lngUBDest
        lngErr = CopyFolder(astrFolderSource(0), astrFolderDest(lngLoop), True)
       Debug.Print "CopyFolder From [" & astrFolderSource(0) & "] To [" & astrFolderDest(lngLoop) & "]"
     Next
End If
'***************
'X To 1
If blnXTo1 Then
    Debug.Print "CopyFolderA: X to 1"
    For lngLoop = lngLBSource To lngUBSource
        lngErr = CopyFolder(astrFolderSource(lngLoop), astrFolderDest(0), True)
        Debug.Print "CopyFolder From [" & astrFolderSource(lngLoop) & "] To [" & astrFolderDest(0) & "]"
    Next
End If
'***************
'X to X ,or 1 To 1
If blnXtoX Then
    Debug.Print "CopyFolderA: X to X"
    For lngLoop = lngLBSource To lngUBSource
        lngErr = CopyFolder(astrFolderSource(lngLoop), astrFolderDest(lngLoop), True)
        Debug.Print "CopyFolder From [" & astrFolderSource(lngLoop) & "] To [" & astrFolderDest(lngLoop) & "]"
    Next
End If CopyFolderA = lngErr
   
End Function
'***********************************************************
Public Function FolderExist(StrFolder)
'Pass Test A
 On Error Resume Next
Dim fso
Set fso = NewFileSystemObject
FolderExist = fso.FolderExists(StrFolder)
End Function
'***********************************************************
Function NewFileSystemObject()
'Pass Test A
'Purpose :建立一个文件系统对象
'返回值：如果建立成功返回一个文件对象，否则返回Nothing.
'使用方法：Set fso=NewFileSystemObject
On Error Resume Next
Set NewFileSystemObject = CreateObject("Scripting.FileSystemObject")
If Err.Number Then
Set NewFileSystemObject = Nothing
End IfEnd Function'***********************************************************
'*希望能够对你有所帮助！
'***********************************************************

Answer 6

name 源文件名 as 目的文件名
此命令在2K下可用,但在98里则无法使用(当源文件名打开的时候),除非用API涵数,试试FileSystemObject