已解決：指定位置提取

咸中咸

各位大神、老師，excel從指定位置（比如：在D盤，但是需要提取的excel表格不在D盤）提取所需要的資料的VBA代碼，請各位不吝賜教！

roych

咸中咸 發(fā)表于 2017-4-2 15:28
可能是我沒有說清楚，我是想在打開的excel表格中點擊導(dǎo)入按鈕，導(dǎo)入指定位置文件（該文件在其他文件夾下 ...

1. Sub test()
   
2. Dim C, sPh As String
   
3. Dim s As String
   
4. sPh = CreateObject("Shell.Application").BrowseForFolder(0, _
   
5.         "選擇文件夾,程序?qū)⒃撐募�夾保存的模塊全部導(dǎo)入！", 0, 0).Self.Path
   
6. For Each C In FileFullName(sPh)
   
7.     With Application.VBE.ActiveVBProject.VBComponents
   
8.         .Import C
   
9.         s = s + vbCrLf + C
   
10.     End With
    
11. Next
    
12. MsgBox "已導(dǎo)入：" & s
    
13. End Sub
    
14. '獲得導(dǎo)入模塊路徑名
    
15. Function FileFullName(sPath As String) As String()
    
16. Dim iCt As Integer
    
17. Dim TemAr() As String
    
18. Dim sDir As String
    
19. sDir = Dir(sPath & "" & "*.bas")
    
20. While Len(sDir)
    
21.     ReDim Preserve TemAr(iCt)
    
22.     TemAr(iCt) = sPath & "" & sDir
    
23.     iCt = iCt + 1
    
24.     sDir = Dir
    
25. Wend
    
26. FileFullName = TemAr
    
27. End Function
    
28. 
    
29. '導(dǎo)出模塊
    
30. Sub SaveThisModule()
    
31. Dim C, sPh As String
    
32. Dim s As String
    
33. sPh = CreateObject("Shell.Application").BrowseForFolder(0, _
    
34.         "選擇文件夾,程序?qū)⒈竟ぷ鞑镜乃�有模塊導(dǎo)出至該文件夾！", 0, 0).Self.Path
    
35. For Each C In ThisWorkbook.VBProject.VBComponents
    
36.     If C.Type = 1 Then
    
37.         Application.VBE.ActiveVBProject.VBComponents(C.Name).Export (sPh & "" & C.Name & ".bas")
    
38.         s = s + vbCrLf + C.Name
    
39.     End If
    
40. Next
    
41. MsgBox "已導(dǎo)出：" & s
    
42. End Sub

復(fù)制代碼

供參考

roych

沒搞懂。導(dǎo)出VBA代碼后，再導(dǎo)入不就好了么？
如果不想導(dǎo)入，只能打開文件再執(zhí)行該文件的VBA代碼。不過個人覺得這樣很復(fù)雜。

咸中咸

roych 發(fā)表于 2017-4-2 12:45
沒搞懂。導(dǎo)出VBA代碼后，再導(dǎo)入不就好了么？
如果不想導(dǎo)入，只能打開文件再執(zhí)行該文件的VBA代碼。不過個人 ...

可能是我沒有說清楚，我是想在打開的excel表格中點擊導(dǎo)入按鈕，導(dǎo)入指定位置文件（該文件在其他文件夾下）中的內(nèi)容

咸中咸

roych 發(fā)表于 2017-4-3 11:35
供參考

謝謝！