以下程序需要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
Function MakePath(Path) As String
MakePath = Path & IIF(Right(Path, 1) = "\", "", "\")
End Function
将代码拷到你窗体的通用(声明)中,然后你就将“App.Path & "\原来…"”都改成“MakePath(App.Path) & "原来…"”,包括后面的代码,只要是有相关的语句(不光是App.Path,从dir控件中获得的路径)都要照着我上面的那样改,你的程序就可以在任意目录下运行了。
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
注释下你加的吧,我看了半天,搞不明白你具体加的位置。
追答晕啊,我无语了
本回答被提问者采纳