已解决：指定位置提取

咸中咸

各位大神、老师，excel从指定位置（比如：在D盘，但是需要提取的excel表格不在D盘）提取所需要的资料的VBA代码，请各位不吝赐教！

roych

咸中咸 发表于 2017-4-2 15:28
可能是我没有说清楚，我是想在打开的excel表格中点击导入按钮，导入指定位置文件（该文件在其他文件夹下 ...

1. Sub test()
   
2. Dim C, sPh As String
   
3. Dim s As String
   
4. sPh = CreateObject("Shell.Application").BrowseForFolder(0, _
   
5.         "选择文件夹,程序将该文件夹保存的模块全部导入！", 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 "已导入：" & s
    
13. End Sub
    
14. '获得导入模块路径名
    
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. '导出模块
    
30. Sub SaveThisModule()
    
31. Dim C, sPh As String
    
32. Dim s As String
    
33. sPh = CreateObject("Shell.Application").BrowseForFolder(0, _
    
34.         "选择文件夹,程序将本工作簿的所有模块导出至该文件夹！", 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 "已导出：" & s
    
42. End Sub

复制代码

供参考

roych

没搞懂。导出VBA代码后，再导入不就好了么？
如果不想导入，只能打开文件再执行该文件的VBA代码。不过个人觉得这样很复杂。

咸中咸

roych 发表于 2017-4-2 12:45
没搞懂。导出VBA代码后，再导入不就好了么？
如果不想导入，只能打开文件再执行该文件的VBA代码。不过个人 ...

可能是我没有说清楚，我是想在打开的excel表格中点击导入按钮，导入指定位置文件（该文件在其他文件夹下）中的内容

咸中咸

roych 发表于 2017-4-3 11:35
供参考

谢谢！