Dùng VBA để đổi tên file

Liên hệ QC

ThichExcel

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
11/10/06
Bài viết
68
Được thích
21
Xin diễn đàn cho tôi hỏi một vấn đề sau
Không biết có thể dùng VBA trong Excel để đổi tên các file .xls hay xla trong một thư mục không, nếu có tôi xin được mọi người chỉ cách hay cho ví dụ đoạn code
Tôi xin cám ơn diễn đàn.
 
Đây là code về 1 sub vừa copy sang thư mục mới vừa đổi tên file (Tigertiger sưu tầm trên Internet),
Tham khảo nhé , bạn sẽ tự sửa thành cái mình cần ngay mà, nếu mắc thì cứ hỏi tiếp nhé
Chúc thành công

PHP:
Sub Copy_and_Rename_To_New_Folder()
''MUST set reference to Windows Script Host Object Model in the project using this code!

'This procedure will copy all files in a folder, and insert the last modified date into the file name'
'it is identical to the other procedure with the exception of the renaming...
'In this example, the renaming has utilized the files Last Modified date to "tag" the copied file.
'This is very useful in quickly archiving and storing daily batch files that come through with the same name on
'a daily basis.  Note: All files in current folder will be copied this way unless condition testing applied as in prior example.

Dim objFSO As FileSystemObject, objFolder As Folder, PathExists As Boolean
Dim objFile As File, strSourceFolder As String, strDestFolder As String
Dim x, Counter As Integer, Overwrite As String, strNewFileName As String
Dim strName As String, strMid As String, strExt As String

Application.ScreenUpdating = False 'turn screenupdating off
Application.EnableEvents = False 'turn events off

'identify path names below:
 strSourceFolder = "C:\MyFolder" 'Source path
 strDestFolder = "C:\Backup" 'destination path, does not have to exist prior to execution
''''''''''NOTE: Path names can be strings built in code, cell references, or user form text box strings''''''
''''''''''example:  strSourceFolder = Range("A1")

'below will verify that the specified destination path exists, or it will create it:
On Error Resume Next
x = GetAttr(strDestFolder) And 0
        If Err = 0 Then 'if there is no error, continue below
        PathExists = True 'if there is no error, set flag to TRUE
        Overwrite = MsgBox("The folder may contain duplicate files," & vbNewLine & _
                    "Do you wish to overwrite existing files with same name?", vbYesNo, "Alert!")
                     'message to alert that you may overwrite files of the same name since folder exists
        If Overwrite <> vbYes Then Exit Sub  'if the user clicks YES, then exit the routine..
        Else: 'if path does NOT exist, do the next steps
        PathExists = False 'set flag at false
        If PathExists = False Then MkDir (strDestFolder) 'If path does not exist, make a new one
        End If 'end the conditional testing

On Error GoTo ErrHandler
   Set objFSO = New FileSystemObject 'creates a new File System Object reference
   Set objFolder = objFSO.GetFolder(strSourceFolder) 'get the folder
      Counter = 0 'set the counter at zero for counting files copied
 
 If Not objFolder.Files.Count > 0 Then GoTo NoFiles 'if no files exist in source folder "Go To" the NoFiles section
 
 For Each objFile In objFolder.Files  'for every file in the folder...
     'parse the name in three pieces, file name middle and extension.  In between, insert the
     'last modified date.  Other options may be a native Date function or a cell refernce to
     'tag the renamed file in place of >=====Format(objFile.DateLastModified, "_mmm_dd_yy")===<<<<
     'if strMid is not used, it can be removed or left as a null "" string
     
        strName = Left(objFile.Name, Len(objFile.Name) - 4) 'remove extension and leave name only
        'strName = Range("A1")  'sample of renaming from cell A1, can by used for strMid as well
        
        strMid = Format(objFile.DateLastModified, "_mmm_dd_yy") 'insert and format files date modified into name
        'strMid = Format(Now(),"_mmm_dd_yy") 'sample of formatting the current date into the file name
        
        strExt = Right(objFile.Name, 4) 'the original file extension
    
        strNewFileName = strName & strMid & strExt  'build the string file name (can be done below as well)
         
             objFile.Copy strDestFolder & "\" & strNewFileName 'copy the file with NEW name!
              
            'objFile.Name = strNewFileName   <====this can be used to JUST RENAME, and not copy
              
            'The below line can be uncommented to MOVE the files AND rename between folders, without copying
            'objFile.Move strDestFolder & "\" & strNewFileName
            
         
           'End If 'where conditional check, if applicable would be placed.
      
                ' Uncomment the If...End If Conditional as needed
         Counter = Counter + 1 'increment the count of files copied.
 Next objFile 'go to the next file
 
MsgBox "All " & Counter & " Files from " & vbCrLf & vbCrLf & strSourceFolder & vbNewLine & vbNewLine & _
          " copied/moved to: " & vbCrLf & vbCrLf & strDestFolder, , "Completed Transfer/Copy!"
          'Message to user confirming completion
          
Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing 'clear the objects

Exit Sub

NoFiles:
'Message to alert if Source folder has no files in it to copy
MsgBox "There Are no files or documents in : " & vbNewLine & vbNewLine & _
 strSourceFolder & vbNewLine & vbNewLine & "Please verify the path!", , "Alert: No Files Found!"
Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing 'clear the objects

Application.ScreenUpdating = True 'turn screenupdating back on
Application.EnableEvents = True 'turn events back on

Exit Sub 'exit sub here to avoid subsequent actions

ErrHandler:
'A general error message
MsgBox "Error: " & Err.Number & Err.Description & vbCrLf & vbCrLf & vbCrLf & _
 "Please verify that all files in the folder are not currently open," & _
  "and the source directory is available"
 
Err.Clear 'clear the error
Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing 'clear the objects
Application.ScreenUpdating = True 'turn screenupdating back on
Application.EnableEvents = True 'turn events back on
End Sub
 
Upvote 0
Cho bạn 1 ví dụ, bạn sẽ tử phăng ra nhé:
Đỗi tên file Tuan.txt trong ổ đĩa D thành Tuan1.txt
PHP:
Sub DOITEN()
   Filename = "D:\Tuan.txt"
   NewFileName = "D:\Tuan1" & skill & ".txt"
   Name Filename As NewFileName
End Sub
ANH TUẤN
 
Upvote 0
Cho mình hỏi 1 chút:
nếu tên file có ký tự tiếng Việt (unicode) thì khi đổi tên nó bảo là "bad file name" gì đó. Nói chung là không làm được. Mọi người có cách nào xử lý quả này không chứ tôi có 2000 files cần đổi tên mà làm tay thì chết.
trân thành cảm ơn.
 
Upvote 0
Cho mình hỏi 1 chút:
nếu tên file có ký tự tiếng Việt (unicode) thì khi đổi tên nó bảo là "bad file name" gì đó. Nói chung là không làm được. Mọi người có cách nào xử lý quả này không chứ tôi có 2000 files cần đổi tên mà làm tay thì chết.
trân thành cảm ơn.

Cái vụ tiếng Việt có dấu ấy ta dùng Scripting.FileSystemObject
Ví dụ:
Đổi file "D:\Nguyễn Anh Tuấn.xlsx" thành "D:\Nguyễn Anh Minh.xlsx"
Mã:
Sub Test()
  Dim fso As Object
  Dim OldName As String, NewName As String
  Set fso = CreateObject("Scripting.FileSystemObject")
  OldName = "D:\" & "Nguy" & ChrW(7877) & "n Anh Tu" & ChrW(7845) & "n.xlsx"
  NewName = "D:\" & "Nguy" & ChrW(7877) & "n Anh Minh.xlsx"
  If fso.FileExists(OldName) Then fso.MoveFile OldName, NewName
  Set fso = Nothing
End Sub
 
Upvote 0
Bác ơi, code trên của bác là đổi 1 file xác định và mình phải nhập đích danh file cần đổi và tên file sau khi đổi.
Vậy em có 2 cột đường dẫn, 1 cột là đường dẫn các file cần đổi tên và 1 cột tương ứng là đường dẫn và tên file sau đổi tên.
Các bác có thể viết giúp em code này được không ạ!
Em cám ơn!
 
Upvote 0
Bác ơi, code trên của bác là đổi 1 file xác định và mình phải nhập đích danh file cần đổi và tên file sau khi đổi.
Vậy em có 2 cột đường dẫn, 1 cột là đường dẫn các file cần đổi tên và 1 cột tương ứng là đường dẫn và tên file sau đổi tên.
Các bác có thể viết giúp em code này được không ạ!
Em cám ơn!

Dùng vòng lặp duyệt qua từng tên file muốn đổi
 
Upvote 0
Nhờ các cao nhân chỉ giáo giúp em ạ. Hàng tuần e phải tải về hơn 100 file .xlsx và .xls và .zip. ví du 100 file nhưng có 10 nguyên tắc đổi tên file khác nhau. Em muốn viết code VBA để đổi tên 1 lần cả 100 file đó, các cao nhân giúp em với ạ
 
Upvote 0
Nhờ các cao nhân chỉ giáo giúp em ạ. Hàng tuần e phải tải về hơn 100 file .xlsx và .xls và .zip. ví du 100 file nhưng có 10 nguyên tắc đổi tên file khác nhau. Em muốn viết code VBA để đổi tên 1 lần cả 100 file đó, các cao nhân giúp em với ạ
Không hiểu bạn để 100 File trong 1 Folder hay nhiều Folder.
Nếu 100 File trong 1 Folder thì tôi làm vầy:
1/ Chọn Folder cần lấy tên File vào 1 cột.
2/ Gõ tên File cần đổi vào 1 cột.
3/ Nhấn nút đổi tên File (xong).
 
Upvote 0
Luật đổi tên mới quan trọng chứ phần đổi đâu có gì.
Chỉ là dùng FileSystemObject lấy mớ file ra và vòng lặp
For Each File in CreateObject("Scripting.FileSystemObject").GetFolder(Filepath).Files
File.Move(newName)
Next File
 
Upvote 0
Không hiểu bạn để 100 File trong 1 Folder hay nhiều Folder.
Nếu 100 File trong 1 Folder thì tôi làm vầy:
1/ Chọn Folder cần lấy tên File vào 1 cột.
2/ Gõ tên File cần đổi vào 1 cột.
3/ Nhấn nút đổi tên File (xong).
Cảm ơn bạn đã trả lời cmt của mình. file của mình nằm trong nhiều folder con nữa ak. mình dùng for each thì sẽ lôi hết nó ra được thôi. nhuwngg còn cái quy tắc kia. mình phải nhập hết quy tắc vào ạ
Bài đã được tự động gộp:

Luật đổi tên mới quan trọng chứ phần đổi đâu có gì.
Chỉ là dùng FileSystemObject lấy mớ file ra và vòng lặp
For Each File in CreateObject("Scripting.FileSystemObject").GetFolder(Filepath).Files
File.Move(newName)
Next File
cảm ơn bạn đã trả lời cmt của mình. mình đang muốn hỏi về đoạn đổi tên , nếu có 100 luật thì tạo 100 cái function rồi dùng select case 100 cái ak bạn
 
Upvote 0
cảm ơn bạn đã trả lời cmt của mình. mình đang muốn hỏi về đoạn đổi tên , nếu có 100 luật thì tạo 100 cái function rồi dùng select case 100 cái ak bạn
Thế thì bạn viết ra 100 cái functions đó, và 100 select case theo ý bạn rồi đưa lên đây sẽ có người chỉnh sửa giùm cho.

Chú: nói chuyện tránh viết tắt. Đầu óc tôi dùng đủ 100% để giải vấn đề, không còn dư một phần trăm nào để tham gia trò chơi đoán chữ.
 
Upvote 0
tên file tuan110219 (110219 là ngày tháng năm) nếu lưu rồi mở lên lại thì làm sao ?
Bối rối !
 
Upvote 0
Thì giải thích vấn đề cho thật rõ.
Chứ nói khơi khơi như này thì người đọc cũng "bối rối".
hôm qua em chạy macro lưu file tên T140319
hôm nay em chạy macro lưu tên file T150319.
có việc nên em muốn mở File ngày hôm nay lên lấy dữ liệu,anh cho em đoạn code mở file
 
Upvote 0
Dim fso As Object

Dim ten_file As String
ten_file = "\\10.156.16.24\SharedFolder\030_EX\04. EXT-PC\Daily Check Order\Nov\checkorder"
Dim OldName As String, NewName As String
Set fso = CreateObject("Scripting.FileSystemObject")
OldName = "\\10.156.16.24\SharedFolder\030_EX\04. EXT-PC\Daily Check Order\Nov\khanh.xlsx"
NewName = ten_file & " " & Month(Date) & "_" & Day(Date) & ".xlsx"
If fso.FileExists(OldName) Then fso.MoveFile OldName, NewName
Set fso = Nothing
code đây ạ !
 
Upvote 0
Dim fso As Object

Dim ten_file As String
ten_file = "\\10.156.16.24\SharedFolder\030_EX\04. EXT-PC\Daily Check Order\Nov\checkorder"
Dim NewName As String
Set fso = CreateObject("Scripting.FileSystemObject")
NewName = ten_file & " " & Month(Date) & "_" & Day(Date) & ".xlsx"

Dim wbMoi as Workbook

If fso.FileExists(NewName) Then Set wbMoi = Workbooks.Open(NewName)

Set fso = Nothing
 
Upvote 0
Application.OnTime TimeValue("10:55:00"), "chekorder"
code này hẹn giờ chạy mà em chưa hiểu xin chỉ giáo
 
Upvote 0
Dim fso As Object

Dim ten_file As String
ten_file = "\\10.156.16.24\SharedFolder\030_EX\04. EXT-PC\Daily Check Order\Nov\checkorder"
Dim NewName As String
Set fso = CreateObject("Scripting.FileSystemObject")
NewName = ten_file & " " & Month(Date) & "_" & Day(Date) & ".xlsx"

Dim wbMoi as Workbook

If fso.FileExists(NewName) Then Set wbMoi = Workbooks.Open(NewName)

Set fso = Nothing

Anh @VetMini cho em xin phép hỏi cái ạ.

Trường hợp nếu trong Foler A chứa 1 File Excel mẫu
Em muốn Copy File mẫu ở trong Folder A qua Folder B và tạo thành 4 tới 5 File ( Có thể nhiều hơn )
theo 1 List tên File Excel cho trước thì VBA có làm được không ạ.

Em cảm ơn anh.
 
Upvote 0
Web KT
Back
Top Bottom