Question

这个vb程序为什么在根目录下运行出现“未找到路径”错误？

以下程序需要filelisftbox、command控件。生成的exe程序放到根目录下，点击command1后不知道为什么提示：“运行时错误'76'，未找到路径”（只要不在根目录下没有问题）：
Private Sub Command1_Click()
dir1 = App.Path & "\原来文件\" '这里也可以直接用："原来文件\"。注意：后面必须有\。
dir2 = App.Path & "\已转换的文件"
If Dir(dir1, vbDirectory) = "" Then
MkDir dir1
End If
If Dir(dir2, vbDirectory) = "" Then
MkDir dir2
End If
'以下代码定义删除原来文件目录下大小为0的文件（因为这些文件无用）。
File1.Path = App.Path & "\原来文件" 'File1是filelisftbox控件。首先要在窗体上加载个filelistbox控件

File1.Refresh
For i = 0 To File1.ListCount - 1
If FileLen(App.Path & "\原来文件\" & File1.List(i)) = 0 Then
Kill App.Path & "\原来文件\" & File1.List(i)
End If
Next i
'以上代码定义删除原来文件目录下大小为0的文件。

Dim arr() As Byte
dir1 = App.Path & "\原来文件\" '这里也可以直接用："原来文件\"。注意：后面必须有\。
dir2 = App.Path & "\已转换的文件"
If Dir(dir1, vbDirectory) = "" Then
MkDir dir1
End If
If Dir(dir2, vbDirectory) = "" Then
MkDir dir2
End If
If Dir(dir1 & IIf(Right(dir1, 1) = "\", "", "\") & "*.*") <> "" Then '如果原来文件文件夹不为空，开始转换。否则停止转换并提醒
m = Dir(dir1 & "*.txt")
Do While m <> ""
s = s & "/" & m
m = Dir
Loop
arr1 = Split(Mid(s, 2), "/")
For i = 0 To UBound(arr1)
filenum = FreeFile
Open dir1 & arr1(i) For Binary As #filenum
ReDim arr(0 To LOF(filenum)) '如果是ReDim arr(1 To LOF(filenum))的话，出现错误，所以把1改成了0。
Get #filenum, , arr
Close #filenum
arr2 = Split(StrConv(arr, vbUnicode), vbCrLf)
filenum = FreeFile
Open dir2 & "\" & Left(arr1(i), Len(arr1(i)) - 4) & "文件" & Right(arr1(i), 4) For Output As #filenum
For J = 0 To UBound(arr2)
arr2(J) = Trim(arr2(J))
If arr2(J) <> "" Then Print #filenum, arr2(J) & "@163.com"
Next
Close #filenum
Next

MsgBox "完成"
Else
MsgBox "无文件"
End If
End Sub

Answer 1

是这样，VB对于路径是这么处理的：如果目标指向某一个盘的根目录，比如C盘，则是“C:\”，最后的那个“\”是有的。如果不是跟目录，则不会有最后的那个“\”，比如C盘下的Windows文件夹中的System32文件夹，则是“C:\Windows\System32”，很闹心是吧。所以如果你把程序放在了根目录下，比如C盘，按照你的代码就成了“C:\\…”显然VB是找不到这个路径的。这里有一个自定义函数，是用来将一个没有以“\”结尾的路径带上“\”，能解决你的问题：
Function MakePath(Path) As String
MakePath = Path & IIF(Right(Path, 1) = "\", "", "\")
End Function
将代码拷到你窗体的通用(声明)中，然后你就将“App.Path & "\原来…"”都改成“MakePath(App.Path) & "原来…"”，包括后面的代码，只要是有相关的语句(不光是App.Path,从dir控件中获得的路径)都要照着我上面的那样改，你的程序就可以在任意目录下运行了。

Answer 2

根目录本身最后一个字符就是\，例如C:\，所以根目录和别的子目录要区别对待，方法：
Dim AppPath As String
AppPath = App.Path & IIf(Right(App.Path, 1) = "\", "", "\")
dir1 = AppPath & "原来文件\"
dir2 = AppPath & "已转换的文件"
..............

追问

试了，不是这个原因

追答

哪一句出错？

追问

又测试了，还是你说的对，但我发现上面的代码还有个问题，就是把原文件中的每行内容转换成eamil格式后，@前面有个空格。请教怎样处理？（名字叫“原来文件”的文件夹中需要放置一个txt文件，内容写上：888888）

追答

Trim可以消除字符串左右两边空格

追问

Trim加到哪里？请示范下

追答

假设原文件中读取的字符串在变量s中：
s = Trim(s) & "@163.com"
debug.print s '运行时检查一下结果

追问

这样我看不懂。你直接说怎样修改上面我的代码吧。在上面的代码什么位置加什么？

追答

问题是你的代码我也看不懂，又没办法调试

追问

我那个代码你直接复制到窗体上生成exe就可以调试了。记住加filelisftbox、command控件。exe运行后自动生成两个文件夹。在其中一个文件夹名字叫“原来文件”的文件夹中放上一个文本文件（里面随便写上一两行数字就行）

追答

Private Sub Command1_Click()
dir1 = App.Path & "\原来文件\" '这里也可以直接用："原来文件\"。注意：后面必须有\。
dir2 = App.Path & "\已转换的文件"
If Dir(dir1, vbDirectory) = "" Then
MkDir dir1
End If
If Dir(dir2, vbDirectory) = "" Then
MkDir dir2
End If
'以下代码定义删除原来文件目录下大小为0的文件（因为这些文件无用）。
File1.Path = App.Path & "\原来文件" 'File1是filelisftbox控件。首先要在窗体上加载个filelistbox控件

File1.Refresh
For i = 0 To File1.ListCount - 1
If FileLen(App.Path & "\原来文件\" & File1.List(i)) = 0 Then
Kill App.Path & "\原来文件\" & File1.List(i)
End If
Next i
'以上代码定义删除原来文件目录下大小为0的文件。

Dim arr() As String
dir1 = App.Path & "\原来文件\" '这里也可以直接用："原来文件\"。注意：后面必须有\。
dir2 = App.Path & "\已转换的文件"
If Dir(dir1, vbDirectory) = "" Then
MkDir dir1
End If
If Dir(dir2, vbDirectory) = "" Then
MkDir dir2
End If
If Dir(dir1 & IIf(Right(dir1, 1) = "\", "", "\") & "*.*") "" Then '如果原来文件文件夹不为空，开始转换。否则停止转换并提醒
m = Dir(dir1 & "*.txt")
Do While m ""
s = s & "/" & m
m = Dir
Loop
arr1 = Split(Mid(s, 2), "/")
For i = 0 To UBound(arr1)
k = 0
filenum = FreeFile
Open dir1 & arr1(i) For Input As #filenum
While Not EOF(filenum)
ReDim Preserve arr(k)
Line Input #filenum, arr(k)
k = k + 1
Wend
Close #filenum
filenum = FreeFile
Open dir2 & "\" & Left(arr1(i), Len(arr1(i)) - 4) & "文件" & Right(arr1(i), 4) For Output As #filenum
For j = 0 To k - 1
arr(j) = Trim(arr(j))
If arr(j) "" Then Print #filenum, arr(j) & "@163.com"
Next
Close #filenum
Next

MsgBox "完成"
Else
MsgBox "无文件"
End If
End Sub

追问

注释下你加的吧，我看了半天，搞不明白你具体加的位置。

追答

晕啊，我无语了