返回列表 上一主題 發帖

(求教)路過高手請協助一下，詳細入內VBA問題?感激~

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
1# 跳轉到 »
發表於 2011-8-24 15:26 | 顯示全部帖子
我是路過的，試試看可不可以用！
Sub 列出檔案加入超連結()
'設定引用項目Microsoft Shell Controls And Automation  (必要)
Dim mySh  As Shell32.Shell
Dim myFolder As Shell32.Folder
Set mySh = CreateObject("shell.application")
Set myFolder = mySh.BrowseForFolder(0, "請指定資料夾", 0)
Columns("A").Clear
Columns("B").Clear
G = myFolder.Items.Item.Path
path1 = G & "\" & "*.*"
file1 = Dir(path1): r = 1
Do While file1 <> ""
    Sheets("工作表1").Cells(r, 1) = file1
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 2), Address:=G & "\" & file1, _
        TextToDisplay:=G & "\" & file1
    r = r + 1
    file1 = Dir '取得下一個檔名
Loop
End Sub
初學VBA乍到twbts

TOP

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
2#
發表於 2011-8-24 16:58 | 顯示全部帖子
持續路過：試試看這樣子可不可以……
Sub 列出檔案加入超連結()
G = InputBox("輸入路俓")
Columns("A").Clear
Columns("B").Clear
path1 = G & "\" & "*.*"
file1 = Dir(path1): r = 1
Do While file1 <> ""
    Sheets("工作表1").Cells(r, 1) = file1
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 2), Address:=G & "\" & file1, _
        TextToDisplay:=G & "\" & file1
    r = r + 1
    file1 = Dir '取得下一個檔名
Loop
End Sub
初學VBA乍到twbts

TOP

        靜思自在 : 布施如播種，以歡喜心滋潤種子，才會發芽。
返回列表 上一主題