山寨机中的战斗机！	程序优化工程师到底对IT界有没有贡献

发帖前咨询了，还是没有答案，关键字：CreateFolder、App.path、路径未找到

楼主zhmsong（老梆子）2005-05-01 13:50:50 在 VB / 基础类提问

目标：我在做一个试题管理系统，最终试题（WORD）上传放在指定的目录下，我通过upLoad方法实现
代码：

Option Explicit
Dim strFldr As String '公用变量
－－－－－－－－－－－－－－－－－－－－－－－－－－－－

'上传文件并进行文件夹是否存在判断

Sub upLoad()
Dim fso As New FileSystemObject
Dim fldr As Folder

strFldr = App.path & "\试题\" & cboAddYear.Text & "\" & _
cboAddTerm.Text & "\" & cboFclty.Text & _
"\" & cboDpt.Text & "\" & cboSpe.Text

Debug.Print strFldr '立即窗口打印strFldr

'判断文件夹是否存在

If fso.FolderExists(strFldr) = True Then
Set fldr = fso.GetFolder(strFldr) '得到fldr句柄
fso.CopyFile txtLink.Text, fldr.Name '复制文件，其中txtLink.Text是源文件地址
Else
Set fldr = fso.CreateFolder(strFldr) '创建文件夹
fso.CopyFile txtLink.Text, fldr.Name '复制文件到指定文件夹
End If

End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
问题：在立即窗口打印的strFldr是“D:\TK\试题\1999-2000\一\管理学院\请选择...\市场营销”
虽然里面存在一个不太合适的“请选择...”但我觉得地址返回正确
不过当程序执行到

Set fldr = fso.CreateFolder(strFldr) '创建文件夹

出现错误提示说“实时错误76 路径未找到”

思考：我考虑过那个不太明白的UNC路径问题，但这里Debug.Print 出来的地址是正确的，所以
一直没有找到答案，请大家帮忙看一下

致谢：谢谢CSDN给予我这样一个提问的好机会，谢谢浏览本帖的朋友们，特别将感谢指点迷津的朋友们问题点数：51、回复次数：10Top

1 楼lc_mtt（柠檬把大飞猪裤子一脱...被大飞猪投诉了）回复于 2005-05-01 14:19:54 得分 5

把前面改为

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr As ObjectTop

2 楼tmran（Rocky 爱瘦鱼）回复于 2005-05-01 14:20:30 得分 6

VB中创建目录好像只能一级一级的创建，不能一次创建完成，你试试看？Top

3 楼qiqi5521（）回复于 2005-05-01 14:35:27 得分 20

Public Function SuperMkdir(ByVal sPath As String) As Boolean
'这是一个建立目录的函数，它能够一次建立多级目录
'INPUT--------------------------------------------------------
'sPath 要建立的目录路径
'OUTPUT-------------------------------------------------------
'成功返回真，失败返回假,注意：如果要建立的文件夹已存在，那么仍然认为
'是成功。判断成功的标准是看函数执行后是否期望的文件夹在硬盘上存在，而不管
'是否真的执行了建立文件夹的操作。

Dim a() As String
Dim sParentPath As String 'sPath的上一级目录的路径
Dim i As Long

On Error GoTo handler

'如果已存在该文件夹，那么直接成功返回。
If PathExists(sPath) Then SuperMkdir = True: Exit Function

Debug.Print sPath
'去掉末尾的反斜杠
If Right(sPath, 1) = "\" Then sPath = Left(sPath, Len(sPath) - 1): Debug.Print "去掉了反斜杠,现在路径是" & sPath

a() = Split(sPath, "\")

If UBound(a) = 0 Then
'只有一项，那么是根目录，肯定存在，
SuperMkdir = True
ElseIf UBound(a) = 1 Then
'有两项,那么如果不存在，用普通的Mkdir就行了。
If Not PathExists(sPath) Then MkDir sPath
Else '如果大于两项，那么就要用到超级建文件夹法了.
sParentPath = a(0) '求得sPath的上一级目录的路径
For i = 1 To UBound(a) - 1
sParentPath = sParentPath & "\" & a(i)
Next i

If SuperMkdir(sParentPath) Then '递归建立好sParentPath，
'现在已经建立好sParentPath了，接下来用普通的Mkdir就可以完成任务了。
If Not PathExists(sPath) Then MkDir sPath
Else '没有成功建立sParentPath,那么只好失败返回了。
Err.Raise 1
End If

End If

SuperMkdir = True '成功
Exit Function

handler:
SuperMkdir = False '出错，返回失败标志a

End Function
Top

4 楼qiqi5521（）回复于 2005-05-01 14:36:29 得分 0

5 楼bdxzq（思考）回复于 2005-05-01 15:45:59 得分 20

Private Sub Command1_Click()
CreateLongDir "d:", "\1\2\3"
End Sub

Sub CreateLongDir(sDrive As String, sDir As String) '建立多级文件夹
Dim sBuild As String

While InStr(2, sDir, "\") > 1
sBuild = sBuild & Left(sDir, InStr(2, sDir, "\") - 1)
sDir = Mid(sDir, InStr(2, sDir, "\"))
If Dir(sDrive & sBuild, 16) = "" Then
MkDir sDrive & sBuild
End If
Wend
End SubTop

6 楼zhmsong（老梆子）回复于 2005-05-01 16:24:27 得分 0

感谢大家，老梆子我是新手，年纪也不小了，嘿嘿，请让我耐心看看，然后给各位热心的假期还能努力工作的朋友加分，谢谢！Top

7 楼zhmsong（老梆子）回复于 2005-05-01 21:14:12 得分 0

谢谢 lc_mtt(柠檬) ，您的办法好像不行，感谢
我在测试底下朋友们的函数，由于是新手，所以请给点时间，谢谢Top

8 楼zhmsong（老梆子）回复于 2005-05-02 01:51:36 得分 0

经过一夜测试，发现qiqi5521()朋友的SuperMkDir（）可以完美的创建一个多级目录，非常感谢
我也从此体会到了“递归”的巧妙！

另外bdxzq(思考) 朋友的等明天我将测试，倒时再最终合计分配分数：）

谢谢大家，祝节日快乐！

Top

9 楼mezhmsong（大老梆子）回复于 2005-05-02 19:52:21 得分 0

艾，不知道规矩连续发了三次，不让发了：（
今天测试了bdxzq(思考）的代码，先谢过了

问题：最后一级目录无法建立成功，因为在最后一级循环时，inStr(2,sDir,"\") = 0
第二：我不太明白inStr(2,sDir,"\")的计算结果
比如 sDir = "1\2\3"
inStr(sDir , "\") = 1 '理解这个
inStr(1,sDir,"\") = 1 '理解这个
inStr(2,sDir,"\") = 3 '这个就不明白了，我按start定义算应等于2

谢谢bdxzq(思考）提供思路简洁的代码，也期待您能再教导我一下，弄明白这个问题，谢谢

Top

10 楼zhmsong（老梆子）回复于 2005-05-04 10:12:08 得分 0

怎么加不了分了，各位帮忙Top