Nhờ bác nào thêm giúp em Full Path hypelink cho đoạn VBA này

Liên hệ QC

dailame9x

Thành viên mới
Tham gia
18/7/19
Bài viết
11
Được thích
3
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 ạ
C:\Users\Design 1\Documents\multi\Chen hinh\Image\1 (1).jpg
 
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 ạ
C:\Users\Design 1\Documents\multi\Chen hinh\Image\1 (1).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)
 
Upvote 0
Đ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
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom