標題: [發問] 超連結 vba [打印本頁]

---

作者: eg0802    時間: 2017-11-26 20:18     標題: 超連結 vba

求救一下各位先進... 公司有個總表,上面有所有採購單號碼(如下圖 J1710 ), 所有訂單號碼都是前面固定五個字, 後面則是不固定. 能否一次性讓EXCEL去抓 某個資料夾裡面的所有採購單連結, 且中間還有一層資料夾 (ex.採購->品牌->採購單號碼) ?
小弟在爬文的時候找到一條vba的超連結,想說修改一下應該可以套用, 但一直不成功(圖片已附).  小弟才薄疏淺,還望各位先進幫幫忙. 在此謝過.
[attach]28029[/attach]

---

作者: adrian_9832    時間: 2017-11-27 14:44

本帖最後由 adrian_9832 於 2017-11-27 14:46 編輯

根據這裡以往前 輩的經驗所分享 : excel 2003 的方向 如果用excel 2003以上的 可能要找一下方式;因為 excel 2003以上 的都把filesearch 太監了 好像換了別的方式!
1: 先搜尋excel的檔案  ---> 2. 再作資料上的處理  (或直接在掃描的內容用上mid 來讀取檔名;這個沒試過)  或 用 left 的方式讀頭5個位
sub test ()
    With Application.FileSearch
    ref = Range("y18")
        .NewSearch
        .LookIn = "path"   '<---你的路徑
        .SearchSubFolders = True
        .Filename = "*.xls" '<---你要找的檔案類型
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
        For I = 1 To .FoundFiles.Count
        On Error Resume Next
        Cells(I, 3) = .FoundFiles(I)
        Next I
        Else
        MsgBox "Folder " & sFolder & " contains no required files"
        End If
    End With
end sub

---

作者: eg0802    時間: 2017-11-27 19:39

回復 2# adrian_9832

AD兄,感謝您撥冗回復.  小弟套用上去顯示執行錯誤'445'.物件不支援此動作.  

Sub test()
    With Application.FileSearch
    ref = Range("y18")
        .NewSearch
        .LookIn = "\\192.168.5.5\Public\共享檔案\2018 CS\"   '<---你的路徑
        .SearchSubFolders = True
        .Filename = "*.xls" '<---你要找的檔案類型
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
        For I = 1 To .FoundFiles.Count
        On Error Resume Next
        Cells(I, 3) = .FoundFiles(I)
        Next I
        Else
        MsgBox "Folder " & sFolder & " contains no required files"
        End If
    End With
End Sub

---

作者: adrian_9832    時間: 2017-11-27 22:59

本帖最後由 adrian_9832 於 2017-11-27 23:02 編輯

如果你用EXCEL 2003  用以上的方法是沒問題的  

但如果你用2003以上的版本  可能要用DIR 才可以解決問題  對於DIR 我只會在文件夾內讀  子目錄內的文檔讀不出來   你試試這個吧 是以前這個論壇的前輩教下來的方式   

Sub 列出檔案()
path1 = "C:\Users\Desktop\test\新增資料夾\*.xls"
file1 = Dir(path1): r = 1
i = 1

Do While file1 <> ""
  Cells(r, 1) = file1
  r = r + 1
  file1 = Dir '取得下一個檔名
Loop



Do Until Cells(i, 1) = ""
If Cells(i, 1) <> Empty Then
    Cells(i, 1) = Left(Cells(i, 1), 2)        '<------2代表你要拿檔案名   從左邊起多少個字  
i = i + 1
End If
Loop


End Sub



詳細可以參考這位前輩 對於 search子目錄 的這篇帖子
http://forum.twbts.com/thread-40-1-1.html

---

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