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

我是剛註冊的新手，希望各路高手協助一下，非常感謝。
問題：在公司網路資料夾中，裡面有許多檔案，想藉由VBA直接讀取所指定的資料夾內的所有檔案，並將其結果直接導入到EXCEL工作表中，EXCEL中我僅需要各個檔案名以及路徑連結(方便點選開啟)即可。

P.s 自己算是VBA新手，還望各位高手協助一下，衷心感激~

play9091

中學生 Rank: 2

帖子: 87
主題: 24
精華: 0
積分: 122
點名: 0
作業系統: win 7
軟體版本: 2016
閱讀權限: 20
性別: 男
註冊時間: 2011-7-9
最後登錄: 2018-1-16

2^#

發表於 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

walisalen

小學生 Rank: 1

帖子: 4
主題: 1
精華: 0
積分: 11
點名: 0
作業系統: win7
軟體版本: 2003
閱讀權限: 10
性別: 男
註冊時間: 2011-8-24
最後登錄: 2011-8-26

3^#

發表於 2011-8-24 16:03 | 只看該作者

play9091您客氣了，真的謝謝您的協助，確實可用，但礙於資料夾在公司區網上面，所以資料夾路徑的方式可用輸入而非用選取的方式嗎?感恩~

TOP

play9091

中學生 Rank: 2

帖子: 87
主題: 24
精華: 0
積分: 122
點名: 0
作業系統: win 7
軟體版本: 2016
閱讀權限: 20
性別: 男
註冊時間: 2011-7-9
最後登錄: 2018-1-16

4^#

發表於 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

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2011-8-24 17:08 | 只看該作者

回復 3# walisalen

Sub Ex()
Dim MyFolder As String, r As Integer, Myfile As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "D:\" '指定開啟時的目錄
.AllowMultiSelect = False '單選
.Show
If .SelectedItems.Count > 0 Then '有選取
MyFolder = .SelectedItems(1) & "\" '目錄資料夾
Else
Exit Sub
End If
End With
Columns("A:B").Clear
Myfile = Dir(MyFolder & "*.xls") '傳回 XLS 檔案
r = 1
Do While Myfile <> ""
Sheets("sheet1").Cells(r, 1) = MyFolder & Myfile
ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 2), Address:=MyFolder & Myfile, TextToDisplay:=Myfile
r = r + 1
Myfile = Dir '取得下一個檔名
Loop
End Sub