Hỏi code VBA copy và đổi tên file hàng loạt.

[jaycer]

Các anh chị giúp em code 1 đoạn VBA copy 1 file có sẵn và đổi tên theo thứ tự i.xlsx, i+1.xlsx đến i+n.xlsx (i và i+n do mình chọn)
Và 1 đoạn VBA đổi tên các file i.xlsx đến i+n.xlsx thành j - "....".xlsx j+n-"....".xlsx với ạ
e cảm ơn mọi người

 

[thanhhuy_hvnh]

Các anh chị giúp em code 1 đoạn VBA copy 1 file có sẵn và đổi tên theo thứ tự i.xlsx, i+1.xlsx đến i+n.xlsx (i và i+n do mình chọn)
Và 1 đoạn VBA đổi tên các file i.xlsx đến i+n.xlsx thành j - "....".xlsx j+n-"....".xlsx với ạ
e cảm ơn mọi người

Mình cũng đi sưu tầm trên web nên giờ copy lại code cho bạn về sửa theo ý mình nhé. Bạn xem có giúp gì cho bạn không.
1. Copy hoặc Move file từ từ mục nguồn đến thư mục đích

Dim fso As Object
Set fso = CreateObject("scripting.FileSystemObject")
On Error Resume Next
 fso.moveFile Source:=duong_dan_thu_muc_nguon & Cells(i, 2) & "_LDD.pdf", Destination:=duong_dan_thu_muc_dich

Nếu copy sẽ thay "move" thành "Copy"
2. Lấy tên các file trong thư mục

Sub Lay_ten_file()
Sheets("DOI_TEN_COPY_BL").Select    '-------Tên sheet can list tên file
Range("A2:b2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
Range("A2").Select

Dim xRow As Long

Dim xDirect$, xFname$, InitialFoldr$

InitialFoldr$ = "\\192.168.1.120\Confidential\IMEX\COPY_BILL_TO_DOCS\"      '----Duong dan mac dinh

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = Application.DefaultFilePath & "\"

.Title = "Please select a folder to list Files from"

.InitialFileName = InitialFoldr$

.Show

If .SelectedItems.Count <> 0 Then

xDirect$ = .SelectedItems(1) & "\"

xFname$ = Dir(xDirect$, 7)

Do While xFname$ <> ""

ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub

3. Đổi tên file theo danh sách

Sub Doi_ten_file()
  Dim i As Long, n As Long
  Dim OldFile As String, NewFile As String, strPath As String
  Dim fso As Object, vFile, arr
  On Error Resume Next
  Set fso = CreateObject("Scripting.FileSystemObject")
  arr = Sheets("DOI_TEN_COPY_BL").Range("G2:G10000").Value
  vFile = Application.GetOpenFilename("Image Files, *.pdf", , , , True)
  If TypeName(vFile) = "Variant()" Then
    strPath = Left$(vFile(1), InStrRev(vFile(1), "\"))
    For i = 1 To UBound(vFile)
      If Len(arr(i, 1)) Then
        If Len(arr(i, 2)) Then
          If Len(arr(i, 3)) Then
            n = n + 1
            OldFile = CStr(vFile(i))
            NewFile = strPath & arr(i, 1) & ".pdf"
            fso.moveFile OldFile, NewFile
          End If
        End If
      End If
    Next
    MsgBox "Doi ten " & n & " files", , "Xong!"
  End If
End Sub

Nguồn: Sưu tầm