Board logo

標題: (求教)路過高手請協助一下，詳細入內VBA問題?感激~ [打印本頁]
作者: walisalen    時間: 2011-8-24 13:56     標題: (求教)路過高手請協助一下，詳細入內VBA問題?感激~

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

P.s 自己算是VBA新手，還望各位高手協助一下，衷心感激~
作者: play9091    時間: 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
作者: walisalen    時間: 2011-8-24 16:03

play9091您客氣了，真的謝謝您的協助，確實可用，但礙於資料夾在公司區網上面，所以資料夾路徑的方式可用輸入而非用選取的方式嗎?感恩~
作者: play9091    時間: 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
作者: GBKEE    時間: 2011-8-24 17:08

回復 3# walisalen
  1. Sub Ex()
  2.     Dim MyFolder As String, r As Integer, Myfile As String
  3.     With Application.FileDialog(msoFileDialogFolderPicker)
  4.         .InitialFileName = "D:\"                '指定開啟時的目錄
  5.         .AllowMultiSelect = False               '單選
  6.         .Show
  7.         If .SelectedItems.Count > 0 Then        '有選取
  8.             MyFolder = .SelectedItems(1) & "\"  '目錄資料夾
  9.         Else
  10.             Exit Sub
  11.         End If
  12.     End With
  13.     Columns("A:B").Clear
  14.     Myfile = Dir(MyFolder & "*.xls")                 '傳回 XLS 檔案
  15.     r = 1
  16.     Do While Myfile <> ""
  17.         Sheets("sheet1").Cells(r, 1) = MyFolder & Myfile
  18.         ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 2), Address:=MyFolder & Myfile, TextToDisplay:=Myfile
  19.         r = r + 1
  20.         Myfile = Dir                                   '取得下一個檔名
  21.     Loop
  22. End Sub
複製代碼
作者: walisalen    時間: 2011-8-24 17:38

回復 4# play9091

1、
輸入以下路徑：
\\tpfile01\Product Info\Data Sheet\繁體中文\Data_series
結果：陣列索引超出範圍

感謝play9091大大~
作者: walisalen    時間: 2011-8-24 17:45

本帖最後由 walisalen 於 2011-8-24 17:49 編輯

TO GBKEE板主大大,

終於成功了，小弟受教~

TO play9091大大,

感謝您的大力協助~

總之，向兩位表達我衷心感謝之意~甘恩啦~:lol



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)