Nhờ bác nào thêm giúp em Full Path hypelink cho đoạn VBA này (1 người xem)

[dailame9x]

Sub hypelinkallflilelist()
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim xFiDialog As FileDialog
Dim xPath As String
Dim i As Integer

Dim curCell As Range
Set curCell = ActiveCell

Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
If xFiDialog.Show = -1 Then
xPath = xFiDialog.SelectedItems(1)
End If
Set xFiDialog = Nothing
If xPath = "" Then Exit Sub
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.getfolder(xPath)
For Each xFile In xFolder.Files
i = i + 1
ActiveSheet.Hyperlinks.Add Cells(curCell.Row + i, curCell.Column), xFile.Path, , , xFile.Name
Next
MsgBox "OK!"
End Sub

Em muốn thêm full path cho các file thành như cột B. nhờ các bác giúp ạ

1 (1).jpg​	C:\Users\Design 1\Documents\multi\Chen hinh\Image\1 (1).jpg
1 (2).jpg​
1 (3).jpg​
1 (4).jpg​

 

[Nhattanktnn]

Sub hypelinkallflilelist()
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim xFiDialog As FileDialog
Dim xPath As String
Dim i As Integer

Dim curCell As Range
Set curCell = ActiveCell

Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
If xFiDialog.Show = -1 Then
xPath = xFiDialog.SelectedItems(1)
End If
Set xFiDialog = Nothing
If xPath = "" Then Exit Sub
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.getfolder(xPath)
For Each xFile In xFolder.Files
i = i + 1
ActiveSheet.Hyperlinks.Add Cells(curCell.Row + i, curCell.Column), xFile.Path, , , xFile.Name
Next
MsgBox "OK!"
End Sub

Em muốn thêm full path cho các file thành như cột B. nhờ các bác giúp ạ

1 (1).jpg​	C:\Users\Design 1\Documents\multi\Chen hinh\Image\1 (1).jpg
1 (2).jpg​
1 (3).jpg​
1 (4).jpg​

Đoạn for each nên thêm điều kiện là file ".JPG" thì xử lý. Nhỡ đâu trong đó có nhiều loại là lỗi code.
Sao cột A không thấy code cho nó vậy bạn? Trong for each nên xử lý cho cột A là curcell.value=xFile.name, còn cột B là curcell.offset(0,1)= xFSO.GetAbsolutePathName(xFile)

 

[dailame9x]

Đoạn for each nên thêm điều kiện là file ".JPG" thì xử lý. Nhỡ đâu trong đó có nhiều loại là lỗi code.
Sao cột A không thấy code cho nó vậy bạn? Trong for each nên xử lý cho cột A là curcell.value=xFile.name, còn cột B là curcell.offset(0,1)= xFSO.GetAbsolutePathName(xFile)

Đoạn for each nên thêm điều kiện là file ".JPG: Em dùng để lấy tên file cho tiện nhỡ nhiều dạng file ảnh
Cảm ơn bác nhé. Em tìm đc cách khách nhanh hơn rồi.
ActiveSheet.Hyperlinks.Add Cells(curCell.Row + i, curCell.Column), xFile.Path, , , xPath & "\" & xFile.Name