Chào Anh chị em trong diễn đàn. Nhờ anh chị em giúp đỡ ạ
Em có 1 Sheet có chứa link File và 1 Folder có chứa các file. Trong sheet đã Link các file tương ứng với tên theo link file.
Vậy em muốn coppy các file chỉ có trong link ra folder khác (Không coppy các tên file không có trong sheet) thì làm như thế nào ạ. FILE CÓ DẠNG
Chào Anh chị em trong diễn đàn. Nhờ anh chị em giúp đỡ ạ
Em có 1 Sheet có chứa link File và 1 Folder có chứa các file. Trong sheet đã Link các file tương ứng với tên theo link file.
Vậy em muốn coppy các file chỉ có trong link ra folder khác (Không coppy các tên file không có trong sheet) thì làm như thế nào ạ. FILE CÓ DẠNG
Option Explicit
Private FSO As Object
Private Sub MoveFile(ByVal filePath As String, ByVal dFolder As String)
FSO.CopyFile filePath, dFolder
End Sub
Private Function CheckFileExists(ByVal filePath As String) As Boolean
CheckFileExists = False
If FSO.FileExists(filePath) Then CheckFileExists = True
End Function
Public Function GetFolderName(Optional Title As String, Optional InitialPath As String) As String
Dim Fdl As FileDialog
Set Fdl = Application.FileDialog(msoFileDialogFolderPicker)
With Fdl
.InitialFileName = InitialPath
If Title <> "" Then .Title = Title
If .Show() Then
GetFolderName = .SelectedItems(1)
Else
MsgBox "No folder is selected", vbInformation
End If
End With
End Function
Public Sub Main()
Dim Rng As Range, Cll As Range, Log As String, I As Long, J As Long
Dim sFolder As String, dFolder As String, fileName As String, filePath As String
sFolder = GetFolderName("Select Source Folder")
dFolder = GetFolderName("Select Destination Folder")
If sFolder = "" And dFolder = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set Rng = Application.InputBox("Select Source Range:", , Selection.Address, Type:=8)
On Error GoTo 0
If Rng Is Nothing Then Exit Sub
Log = "File list does not exist:"
For Each Cll In Rng
If Cll.Hyperlinks.Count > 0 Then
fileName = Cll.Hyperlinks(1).Address
filePath = sFolder & "\" & fileName
If CheckFileExists(filePath) Then
J = J + 1
MoveFile filePath, dFolder & "\"
Else
I = I + 1
Log = Log & vbNewLine & Cll.Address(0, 0)
End If
End If
Next
If I > 0 Then MsgBox Log
MsgBox "Done!, Copied " & J & " files."
Set FSO = Nothing
End Sub
Cách dùng:
Chạy sub Main
-> Bảng chọn folder đầu tiên hiện ra là chọn thư mục chứa file nguồn
-> Bảng chọn folder thứ 2 là chọn thư mục chứa file cần copy đến
-> Bảng Inputbox hiện lên là chọn vùng dữ liệu (Range) chứa hyperlinks
Option Explicit
Private FSO As Object
Private Sub MoveFile(ByVal filePath As String, ByVal dFolder As String)
FSO.CopyFile filePath, dFolder
End Sub
Private Function CheckFileExists(ByVal filePath As String) As Boolean
CheckFileExists = False
If FSO.FileExists(filePath) Then CheckFileExists = True
End Function
Public Function GetFolderName(Optional Title As String, Optional InitialPath As String) As String
Dim Fdl As FileDialog
Set Fdl = Application.FileDialog(msoFileDialogFolderPicker)
With Fdl
.InitialFileName = InitialPath
If Title <> "" Then .Title = Title
If .Show() Then
GetFolderName = .SelectedItems(1)
Else
MsgBox "No folder is selected", vbInformation
End If
End With
End Function
Public Sub Main()
Dim Rng As Range, Cll As Range, Log As String, I As Long, J As Long
Dim sFolder As String, dFolder As String, fileName As String, filePath As String
sFolder = GetFolderName("Select Source Folder")
dFolder = GetFolderName("Select Destination Folder")
If sFolder = "" And dFolder = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set Rng = Application.InputBox("Select Source Range:", , Selection.Address, Type:=8)
On Error GoTo 0
If Rng Is Nothing Then Exit Sub
Log = "File list does not exist:"
For Each Cll In Rng
If Cll.Hyperlinks.Count > 0 Then
fileName = Cll.Hyperlinks(1).Address
filePath = sFolder & "\" & fileName
If CheckFileExists(filePath) Then
J = J + 1
MoveFile filePath, dFolder & "\"
Else
I = I + 1
Log = Log & vbNewLine & Cll.Address(0, 0)
End If
End If
Next
If I > 0 Then MsgBox Log
MsgBox "Done!, Copied " & J & " files."
Set FSO = Nothing
End Sub
Cách dùng:
Chạy sub Main
-> Bảng chọn folder đầu tiên hiện ra là chọn thư mục chứa file nguồn
-> Bảng chọn folder thứ 2 là chọn thư mục chứa file cần copy đến
-> Bảng Inputbox hiện lên là chọn vùng dữ liệu (Range) chứa hyperlinks
Hiểu đơn giản code đó để copy các tên file có trong vùng chọn ra một folder khác.
Còn cách làm thì tùy bạn thôi, bạn thích copy riêng pdf thì bạn chọn hyperlinks cho pdf ở một vùng khác đi, rồi chọn vùng có tên pdf thôi
Hiểu đơn giản code đó để copy các tên file có trong vùng chọn ra một folder khác.
Còn cách làm thì tùy bạn thôi, bạn thích copy riêng pdf thì bạn chọn hyperlinks cho pdf ở một vùng khác đi, rồi chọn vùng có tên pdf thôi
Làm theo kiểu nào cũng được nhưng phải trước sau như một. Bài #1 link chỉ chứa tên tập tin, vd. A00003196_8721120_TF_Customer.txt, bây giờ link lại chứa cả thư mục vd. pdf\A00001496\A00003196_8721120_TF_Customer.pdf.
Hãy chọn 1 kiểu thôi. Ta chọn cách 2. Trong trường hợp này thư mục cụ tổ của các tập tin pdf là thư mục PDF. Giả sử thư mục cụ tổ của các tập tin txt là TXT, của Docx là DOCX ...
nên trong code có fso.CopyFile srcFileName, destFileName. Tức code chỉ sao chép sang chỗ mới chứ không di chuyển sang chỗ mới - ở nguồn vẫn tồn tại. Code bài #2 là MoveFile, tức di chuyển - ở nguồn không còn.
Mã:
Option Explicit
Public Sub Saochep()
Dim Rng As Range, cell_ As Range, message As String
Dim srcFileName As String, destFileName As String, destFolder As String
Dim fd As FileDialog, fso As Object
Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
With Fd
.Title = "Ch" & ChrW(7885) & "n th" & ChrW(432) & " m" & ChrW(7909) & "c " & ChrW(273) & ChrW(237) & "ch"
If .Show() Then
destFolder = .SelectedItems(1)
Else
Exit Sub
End If
End With
On Error Resume Next
Set Rng = Application.InputBox("Hay chon vung chua links.", "Chon Range", Type:=8)
On Error GoTo 0
If Rng Is Nothing Then Exit Sub
message = "Cac tap tin khong ton tai:"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each cell_ In Rng
If cell_.Hyperlinks.Count > 0 Then
srcFileName = ThisWorkbook.Path & "\" & cell_.Hyperlinks(1).Address
destFileName = destFolder & Mid(srcFileName, InStrRev(srcFileName, "\"))
If fso.FileExists(srcFileName) Then
fso.CopyFile srcFileName, destFileName
Else
message = message & vbCrLf & srcFileName
End If
End If
Next cell_
Set fso = Nothing
If Len(message) > 30 Then MsgBox message
MsgBox "Da lam xong"
End Sub
Còn bài của bạn ấy theo diễn tả thì em nghĩ em làm vậy cũng hợp lý rồi. Nếu muốn nhiều kiểu, cái thì tên, cái thì đường dẫn cũng được nhưng phải nói ngay từ đầu, hoặc là diễn tả lại cho rõ ràng. Đằng này diễn tả cũng mơ hồ, hướng dẫn cũng không hiểu nữa
Làm theo kiểu nào cũng được nhưng phải trước sau như một. Bài #1 link chỉ chứa tên tập tin, vd. A00003196_8721120_TF_Customer.txt, bây giờ link lại chứa cả thư mục vd. pdf\A00001496\A00003196_8721120_TF_Customer.pdf.
Hãy chọn 1 kiểu thôi. Ta chọn cách 2. Trong trường hợp này thư mục cụ tổ của các tập tin pdf là thư mục PDF. Giả sử thư mục cụ tổ của các tập tin txt là TXT, của Docx là DOCX ...
Thao tác: Do link đã chứa cả các thư mục cụ tổ nên không còn công đoạn chọn thư mục nguồn nữa. Chỉ còn chọn thư mục đích và vùng - Range chứa các link để copy. Nếu muốn mỗi lần chạy code chỉ copy một loại tập tin (pdf, txt, docx, ...) thì các link của chúng phải nằm ở những vùng khác nhau, vd. PDF ở B2:E3, DOCX ở G2:L8 ... Khi chạy code thì chọn vùng - Range thích hợp.
Do bạn dùng từ COPY
nên trong code có fso.CopyFile srcFileName, destFileName. Tức code chỉ sao chép sang chỗ mới chứ không di chuyển sang chỗ mới - ở nguồn vẫn tồn tại. Code bài #2 là MoveFile, tức di chuyển - ở nguồn không còn.
Mã:
Option Explicit
Public Sub Saochep()
Dim Rng As Range, cell_ As Range, message As String
Dim srcFileName As String, destFileName As String, destFolder As String
Dim fd As FileDialog, fso As Object
Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
With Fd
.Title = "Ch" & ChrW(7885) & "n th" & ChrW(432) & " m" & ChrW(7909) & "c " & ChrW(273) & ChrW(237) & "ch"
If .Show() Then
destFolder = .SelectedItems(1)
Else
Exit Sub
End If
End With
On Error Resume Next
Set Rng = Application.InputBox("Hay chon vung chua links.", "Chon Range", Type:=8)
On Error GoTo 0
If Rng Is Nothing Then Exit Sub
message = "Cac tap tin khong ton tai:"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each cell_ In Rng
If cell_.Hyperlinks.Count > 0 Then
srcFileName = ThisWorkbook.Path & "\" & cell_.Hyperlinks(1).Address
destFileName = destFolder & Mid(srcFileName, InStrRev(srcFileName, "\"))
If fso.FileExists(srcFileName) Then
fso.CopyFile srcFileName, destFileName
Else
message = message & vbCrLf & srcFileName
End If
End If
Next cell_
Set fso = Nothing
If Len(message) > 30 Then MsgBox message
MsgBox "Da lam xong"
End Sub
Tôi đã viết cụ thể như thế mà bạn không hiểu thì bó tay.
Trên sheet không ghi toàn bộ đường dẫn tới tập tin pdf, txt, docx ... Chỉ ghi đoạn đường dẫn bắt đầu từ <CỤ TỔ>, tức chỉ ghi <CỤ TỔ>\<Tên tập tin pdf, txt, docx>, mà <CỤ TỔ> và tập tin Excel phải nằm cùng thư mục.
Vd. có thư mục "C:\Users\Admin\Desktop". Trong cùng thư mục "C:\Users\Admin\Desktop" có tập tin Excel, và các thư mục con PDF, TXT, DOCX, ...
Trong thư mục PDF có thư mục con A00001496, và trong thư mục này có tập tin A00001496_14561120_TF_ban.pdf thì trên sheet ghi
PDF\A00001496\A00001496_14561120_TF_ban.pdf, tức bắt đầu từ <CỤ TỔ> = PDF (ở cùng thư mục với tập tin Excel)
Nếu trong thư mục chính "F:\" có tập tin Excel và thư mục A00001496, mà trong thư mục này có tập tin A00001496_14561120_TF_ban.pdf thì thư mục A00001496 = <CỤ TỔ>. Vậy trên sheet nhập "A00001496\A00001496_14561120_TF_ban.pdf" chứ không nhập toàn bộ đường dẫn là "F:\A00001496\A00001496_14561120_TF_ban.pdf" như trong hình.
Tôi đã nói với bạn rồi. Làm theo cách nào cũng làm được miễn là phải nhất quán, phải trước sau như một. Ở bài đầu bạn nhập trên sheet chỉ mỗi tên tập tin TXT, sau đó đến PDF thì bạn chỉ nhập một đoạn của đường dẫn. Bây giờ bạn lại nhập toàn bộ đường dẫn. Mà tập tin Excel bạn có ở thư mục "C:\Users\Admin\Desktop", trong khi đó tập tin pdf lại ở "F:\A00001496\A00001496_14561120_TF_ban.pdf". Trong trường hợp này <CỤ TỔ> = "F:\" là thư mục nằm trên F thì là sao có thể nằm cùng thư mục với tập tin Excel nằm trên C như tôi hướng dẫn? Hãy suy nghĩ chút đi. Mỗi code được viết cho một giả thiết cụ thể.
