[求助]如何用vba获取指定的搜索路径

gjliang · 发表于 2005-4-13 17:20:00

我想得到我添加的搜索文件路径，不知用vba如何实现，谢谢指导！

gjliang · 发表于 2005-4-14 13:30:00

对于上面的问题，我想到了一个变通的办法，在本人电脑上均没问题,可一换就有问题!
由于我是用vba调用外部块，每次安装到不同的电脑，外部块的绝对路径都要改变，我想请问一下如果获得dvb文件的路径，这样的话就可以方便的获得外部块的绝对路径了。
看来没有人遇到过这个问题，我想了个解决办法：
Dim oVbe As Object
Dim aa As Variant
Dim bb As String
Dim a As Integer
Dim b As Integer
Dim c As Integer
Set oVbe = Application.VBE
aa = oVbe.VBProjects(1).FileName '获得当前dvb文件路径及文件名
a = Len(aa) '获得全部路径的字段长度
bb = "jingtong.dvb" '定义当前文件的名称
b = Len(bb) '获得当前文件名的字段长度
c = a - b '用全部字段长减去文件名字段长度
Dim aaa As String
aaa = Left(aa, c) '获得当前dvb文件存放的路径
我的这个方法自己认为不好，因为我在2002，2004，2005上测试时均能通过，但是当换了一台电脑后就又出现调用外部块无法找到路径的问题！哪位高手有好的办法还麻烦告知，谢谢了！

yulijin608 · 发表于 2005-4-14 15:54:00

以下程序可以得到每一个支持文件搜索路径.
Sub FindSupportPath()
Dim curSupportPath As Variant
Dim i As Integer
curSupportPath = StoDim(ThisDrawing.Application.Preferences.Files, ";")
For i = 0 To UBound(curSupportPath)
   MsgBox curSupportPath(i)
Next
End Sub
Function StoDim(ByVal s As String, Optional div As String) As Variant
Dim s_len As Integer '字符串长度
Dim s_p As Integer    '查找开始位置
Dim gs() As String
Dim i As Integer
Dim j As Integer
If div = "" Then div = " "
i = 0
s_p = 1
s = LTrim(s + div)
s_len = Len(s)
j = 0
While s_p  1 Then
   ReDim Preserve gs(j)
   gs(j) = Left(s, s_p - 1)
   j = j + 1
   End If
   s = LTrim(Right(s, s_len - s_p))
   s_len = Len(s)    '替换后新串长度
   s_p = 1    '下次开始查找的位置
   i = i + 1
   Else
   s_p = s_p + 1    '如果没有找分隔符，从下一个开始
   End If
Wend
'空数组
If j = 0 Then Exit Function
StoDim = gs    '得到字符串数组
End Function

[求助]如何用vba获取指定的搜索路径

发表回复

精选推荐