代码如下:
Private Sub Image1_Click()
 Dim yPath As String 
 Dim newPath As String Dim WJJ1 As String
 Dim WJJ1 As String Dim Strs1 As String
 Dim Strs2 As String Dim FileName1 As String
 Dim FileName2 As String Dim fso As New FileSystemObject If Me.Text4.Text = "" Then
    MsgBox "请确认编号后,再选择图片!", 64, "提示"
 Else
    Me.CommonDialog1.ShowOpen
    yPath = Me.CommonDialog1.FileName
    WJJ1 = Text2(0).Text
    WJJ2 = Text2(1).Text
    Strs1 = App.Path & "\cfg_KSPMT\" & WJJ1
    Strs2 = App.Path & "\cfg_KSPMT\WJJ1\" & WJJ2
    '在当前目录中查找文件
    FileName1 = Dir(Strs1)
    FileName2 = Dir(Strs2)
    If FileName1 = "" Then
      fso.CreateFolder (Trim(Strs1))
      If FileName2 = "" Then
      fso.CreateFolder (Trim(Strs2))
      If yPath <> "" Then
       newPath = App.Path & "\cfg_KSPMT\WJJ1\WJJ2\" & Me.Text5.Text & Me.Text4.Text & Me.Text1(7).Text & ".jpg"
       FileCopy yPath, newPath
       Me.Image1.Picture = LoadPicture(newPath)
       phoPath = "\cfg_KSPMT\" & Me.Text5.Text & Me.Text4.Text & Me.Text1(7).Text & ".jpg"
      End If: End If
    Else
     If FileName2 = "" Then
      fso.CreateFolder (Trim(Strs2))
      If yPath <> "" Then
       newPath = App.Path & "\cfg_KSPMT\WJJ1\WJJ2\" & Me.Text5.Text & Me.Text4.Text & Me.Text1(7).Text & ".jpg"
       FileCopy yPath, newPath
       Me.Image1.Picture = LoadPicture(newPath)
       phoPath = "\cfg_KSPMT\" & Me.Text5.Text & Me.Text4.Text & Me.Text1(7).Text & ".jpg"
      End If
     Else
      If yPath <> "" Then
       newPath = App.Path & "\cfg_KSPMT\WJJ2\WJJ2\" & Me.Text5.Text & Me.Text4.Text & Me.Text1(7).Text & ".jpg"
       FileCopy yPath, newPath
       Me.Image1.Picture = LoadPicture(newPath)
       phoPath = "\cfg_KSPMT\" & Me.Text5.Text & Me.Text4.Text & Me.Text1(7).Text & ".jpg"
      End If
  End If: End If: End If
End Sub上面的问题找了好多资料也没找到相关的方法!这书上的知识真是太少了!请高手帮助调试一下?

解决方案 »

  1.   

    很好用的代码
    '直接创建多级文件夹,一定要写最后的斜线
    Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As LongSub CreateDir()
        MakeSureDirectoryPathExists "D:\Program Files\AutoCAD 2006\Express\"
    End Sub
      

  2.   

    但是MakeSureDirectoryPathExists "D:\Program Files\AutoCAD 2006\Express\"的条件怎么接入呢?
      

  3.   

    也没看出来的问题到底是什么啊,只是看了标题给你了这段代码像你的程序中如果要用的话就这样就可以MakeSureDirectoryPathExists  App.Path & "\cfg_KSPMT\WJJ1\WJJ2\"
      

  4.   

    不行呀!
    App.Path & "\cfg_KSPMT\WJJ1\WJJ2\" 
    您这是按指定的名字新建文件夹!我是说动态的!
    我的条件是: WJJ1 = Text2(0).Text
                 WJJ2 = Text2(1).Text这两个文本框是动态获取不同的文本,如果它们发生变化时怎么办?我的意思是不管它们发生什么变化!当单击Image1→选择相应的图片→确定后都会按照这两个文本框中的名字新建父子级关系的两个文件夹。如果有则不新建!
      

  5.   

    那你就这样呗,文件夹存在的话,它不会建立的,只有不存在才会建立,你试下就知道了,
    MakeSureDirectoryPathExists App.Path & "\cfg_KSPMT\"& Text2(0).Text &"\"& Text2(1).Text  &"\" 
      

  6.   

    条件是: WJJ1 = Text2(0).Text 
            WJJ2 = Text2(1).Text MakeSureDirectoryPathExists App.Path & "\cfg_KSPMT\" & WJJ1 & "\" & WJJ2 & "\" 
      

  7.   

    问题主要出在这行:
    fso.CreateFolder (Trim(Strs2)) 报文件路径不存在!
      

  8.   

        WJJ1 = Text2(0).Text 
        WJJ2 = Text2(1).Text 
        Strs1 = App.Path & "\cfg_KSPMT\" & WJJ1 
        Strs2 = App.Path & "\cfg_KSPMT\" & WJJ1 & "\" & WJJ2