vb文件夹的删除问题

Question

谢谢大家的帮忙，vb的打印问题已经解决了，但今天又产生了新的问题，文件夹删除不了
源码如下：
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim Fso
Dim FsysPrivate Sub Command1_Click()
    '\\\\\\\创建一个临时文件夹dy\\\\\\\
    Dim Fso
    Set Fso = CreateObject("scripting.filesystemobject")
    Fso.CreateFolder ("c:\dy")  （因第一次没删除，第二次运行到此错）
    
    '\\\\\\\将模板拷贝至临时文件夹并打开\\\\\\\
    Set xlsApp = Excel.Application
    xlsApp.Visible = False
    Set xlsBook = xlsApp.Workbooks.Open("C:\WINDOWS\模板.xls")
    Set Fso = CreateObject("scripting.filesystemobject")
    Fso.CopyFile "C:\WINDOWS\模板.xls", "C:\dy\检验单.xls"
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\检验单.xls")
    
    '\\\\\\\以下是基本信息填写\\\\\\\
    xlsApp.Sheets(1).Cells(4, 3) = Text1.Text
    xlsApp.Sheets(1).Cells(5, 8) = Text2.Text
    xlsApp.Sheets(1).Cells(5, 4) = Text3.Text
    xlsApp.Sheets(1).Cells(10, 5) = Text4.Text
    xlsApp.Sheets(1).Cells(5, 11) = Combo1.Text
    xlsApp.Sheets(1).Cells(4, 11) = Combo2.Text
    xlsApp.Sheets(1).Cells(4, 8) = Combo3.Text
    xlsApp.Sheets(1).Cells(10, 11) = Combo4.Text
    xlsApp.Sheets(1).Cells(6, 5) = Combo5.Text
    xlsBook.Close (True)
    xlsApp.Quit
End Sub
Private Sub Command3_Click()  '\\\\\\\第一份\\\\\\\
If Check1.Value = 1 Then
    '\\\\\\\将临时文件夹的检验单再拷贝一份叫具体名称\\\\\\\
    Set xlsApp = Excel.Application
    xlsApp.Visible = False
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\检验单.xls")
    Set Fso = CreateObject("scripting.filesystemobject")
    Fso.CopyFile "C:\dy\检验单.xls", "C:\dy\血常规.xls"
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\血常规.xls")
    
    '\\\\\\\填写具体检验名称\\\\\\\
    Set xlsApp = Excel.Application
    xlsApp.Visible = False
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\血常规.xls")
    xlsApp.Sheets(1).Cells(9, 3) = "血常规"
    xlsApp.Sheets(1).Cells(8, 3) = "血"
    xlsBook.Close (True)
    xlsApp.Quit
    
    '\\\\\\\打印填好的检验单\\\\\\\
    Set ExcelxlApp = CreateObject("Excel.Application") '创建EXCEL对象
    Set ExcelxlBook = ExcelxlApp.Workbooks.Open("C:\dy\血常规.xls") '打开已存在的ExcEL工作薄文件
    ExcelxlApp.Visible = False '设置EXCELS对象可见(或不可见)
    Set ExcelxlSheet = ExcelxlBook.Worksheets("sheet1") 
    ExcelxlSheet.PrintOut
End If'\\\\\\\第二份\\\\\\\
  If Check12.Value = 1 Then
    '\\\\\\\将临时文件夹的检验单再拷贝一份叫具体名称\\\\\\\
    Set xlsApp = Excel.Application
    xlsApp.Visible = False
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\检验单.xls")
    Set Fso = CreateObject("scripting.filesystemobject")
    Fso.CopyFile "C:\dy\检验单.xls", "C:\dy\肝功能.xls"
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\肝功能.xls")
    
    '\\\\\\\填写具体检验名称\\\\\\\
    Set xlsApp = Excel.Application
    xlsApp.Visible = False
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\肝功能.xls")
    xlsApp.Sheets(1).Cells(9, 3) = "肝功能"
    xlsApp.Sheets(1).Cells(8, 3) = "血"
    xlsBook.Close (True)
    xlsApp.Quit
    
    '\\\\\\\打印填好的检验单\\\\\\\
    Set ExcelxlApp = CreateObject("Excel.Application") '创建EXCEL对象
    Set ExcelxlBook = ExcelxlApp.Workbooks.Open("C:\dy\肝功能.xls") '打开已存在的ExcEL工作薄文件
    ExcelxlApp.Visible = False '设置EXCELS对象可见(或不可见)
    Set ExcelxlSheet = ExcelxlBook.Worksheets("sheet1") '问题出在这里,sheet1加双引
    ExcelxlSheet.PrintOut
End If   
End Sub
Private Sub Command4_Click()
Shell "cmd.exe /c taskkill /f /im excel.exe"
Shell "tskill excel"
Shell "cmd /c del c:\dy\*.xls /q", 0
Shell "cmd /c del c:\dy /q", 0
End SubPrivate Sub Form_Load()
Text4.Text = Date
End Sub
第一次运行是完全通过，但 c:\dy 并没有删除，里面还有文件，下次运行程序时就说实时错误，文件已存在
请大家看看，怎么修改？谢谢！

Answer 1

你调用了多次 Workbooks.Open(...),却有几次没调用close，文件还在使用中，当然删除不了！记住，Open和close成对出现！

Answer 2

您好，按照您的意思，Open和close成对出现！
我将代码改成了这样
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim Fso
Private Sub Command1_Click()
    '\\\\\\\创建一个临时文件夹\\\\\\\
    Dim Fso
    Set Fso = CreateObject("scripting.filesystemobject")
    Fso.CreateFolder ("c:\dy")
    
    '\\\\\\\将模板拷贝至临时文件夹并打开\\\\\\\
    Set xlsApp = Excel.Application
    xlsApp.Visible = False
    Set xlsBook = xlsApp.Workbooks.Open("C:\WINDOWS\模板.xls")
    Set Fso = CreateObject("scripting.filesystemobject")
    Fso.CopyFile "C:\WINDOWS\模板.xls", "C:\dy\检验单.xls"
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\检验单.xls")
    
    '\\\\\\\以下是基本信息填写\\\\\\\
    xlsApp.Sheets(1).Cells(4, 3) = Text1.Text
    xlsApp.Sheets(1).Cells(5, 8) = Text2.Text
    xlsApp.Sheets(1).Cells(5, 4) = Text3.Text
    xlsApp.Sheets(1).Cells(10, 5) = Text4.Text
    xlsApp.Sheets(1).Cells(5, 11) = Combo1.Text
    xlsApp.Sheets(1).Cells(4, 11) = Combo2.Text
    xlsApp.Sheets(1).Cells(4, 8) = Combo3.Text
    xlsApp.Sheets(1).Cells(10, 11) = Combo4.Text
    xlsApp.Sheets(1).Cells(6, 5) = Combo5.Text
    xlsBook.Close (True)
    xlsApp.Quit
End Sub
Private Sub Command3_Click()
 
  '\\\\\\\第一份\\\\\\\
 If Check1.Value = 1 Then
    '\\\\\\\将临时文件夹的检验单再拷贝一份叫具体名称\\\\\\\
    Set xlsApp = Excel.Application
    xlsApp.Visible = False
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\检验单.xls")
    Set Fso = CreateObject("scripting.filesystemobject")
    Fso.CopyFile "C:\dy\检验单.xls", "C:\dy\血常规.xls"
     xlsBook.Close (True)
    xlsApp.Quit
    
    
    '\\\\\\\填写具体检验名称\\\\\\\
    Set xlsApp = Excel.Application
    xlsApp.Visible = False
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\血常规.xls")
    xlsApp.Sheets(1).Cells(9, 3) = "血常规"
    xlsApp.Sheets(1).Cells(8, 3) = "血"
    xlsBook.Close (True)
    xlsApp.Quit
    
    '\\\\\\\打印填好的检验单\\\\\\\
    Set ExcelxlApp = CreateObject("Excel.Application") '创建EXCEL对象
    Set ExcelxlBook = ExcelxlApp.Workbooks.Open("C:\dy\血常规.xls") '打开已存在的ExcEL工作薄文件
    ExcelxlApp.Visible = False '设置EXCELS对象可见(或不可见)
    Set ExcelxlSheet = ExcelxlBook.Worksheets("sheet1") 'sheet1加双引
    ExcelxlSheet.PrintOut End If
 
 '\\\\\\\第二份\\\\\\\
  If Check12.Value = 1 Then
    '\\\\\\\将临时文件夹的检验单再拷贝一份叫具体名称\\\\\\\
    Set xlsApp = Excel.Application
    xlsApp.Visible = False
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\检验单.xls")
    Set Fso = CreateObject("scripting.filesystemobject")
    Fso.CopyFile "C:\dy\检验单.xls", "C:\dy\肝功能.xls"
     xlsBook.Close (True)
    xlsApp.Quit    
    '\\\\\\\填写具体检验名称\\\\\\\
    Set xlsApp = Excel.Application
    xlsApp.Visible = False
    Set xlsBook = xlsApp.Workbooks.Open("C:\dy\肝功能.xls")
    xlsApp.Sheets(1).Cells(9, 3) = "肝功能"
    xlsApp.Sheets(1).Cells(8, 3) = "血"
    xlsBook.Close (True)
    xlsApp.Quit
    
    '\\\\\\\打印填好的检验单\\\\\\\
    Set ExcelxlApp = CreateObject("Excel.Application") '创建EXCEL对象
    Set ExcelxlBook = ExcelxlApp.Workbooks.Open("C:\dy\肝功能.xls") '打开已存在的ExcEL工作薄文件
    ExcelxlApp.Visible = False '设置EXCELS对象可见(或不可见)
    Set ExcelxlSheet = ExcelxlBook.Worksheets("sheet1") 'sheet1加双引
    ExcelxlSheet.PrintOut End If
    
End SubPrivate Sub Command4_Click()Shell "cmd.exe /c taskkill /f /im excel.exe"
Shell "tskill excel"
Shell "cmd /c del c:\dy\*.xls /q", 0
Shell "cmd /c del c:\dy /q", 0
End SubPrivate Sub Form_Load()
Text4.Text = Date
End Subc:\dy 里的文件是都删除了，但文件夹还是没有删除。
好像红色的后面加不了close

Answer 3

你的代码很牛X，我看着晕，Shell来操作文件你都能想得出来，呵呵！不过del命令不是用来删文件夹的，删文件用rd命令，即：
Shell "cmd /c del c:\dy /q", 0
改为
Shell "cmd /c rd c:\dy /q", 0VB有自己的文件管理方法的，少用shell，这很不稳定；你代码中的的ExcelxlApp不停地打开退出，好像不费电一样！
....多找点资料来看看，Csdn中有很多这方面的例子的。好运！

Answer 4

Shell "cmd /c del c:\dy /q", 0
改为
Shell "cmd /c rd c:\dy /q /s", 0 没有 /s 参数可能会失败

Answer 5

神一般的代码,各种重复打开和定义
你都用了 Set Fso = CreateObject("scripting.filesystemobject")
还要调用shell删除文件夹?
直接fso.deleteFloder "C:\windows"不就行了

Answer 6

Option Explicit
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'常量声明区域
Public Const FO_MOVE As Long = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_DELETE As Long = &H3
Public Const FO_RENAME As Long = &H4
Public Const FOF_MULTIDESTFILES As Long = &H1
Public Const FOF_CONFIRMMOUSE As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
Public Const FOF_CREATEPROGRESSDLG As Long = &H0
Public Const FOF_ALLOWUNDO As Long = &H40
Public Const FOF_FILESONLY As Long = &H80
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public Const FOF_NOCONFIRMMKDIR As Long = &H200
'结构声明区域
Public Type SHFILEOPSTRUCT
    hwnd As Long '窗口句柄
    wFunc As Long '执行的操作
    pFrom As String '原地点
    pTo As String '目标地点
    fFlags As Long '操作执行方式
    fAnyOperationsAborted As Long '错误代码返回
    hNameMappings As Long
    lpszProgressTitle As String
End Type
'API函数声明区域
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'函数功能：移动、删除、复制指定文件夹下的文件
'功能描述：
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
Public Declare Function SHFileOperation Lib "Shell32.dll" Alias _
                            "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'函数定义区域
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'过程功能：删除指定文件夹下的文件
'参数说明：strFolder：指定的文件夹
'        ：lngHandle：执行操作的对象的句柄
'返回说明：
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
Public Function funDeleteAllFileInFolder(ByVal lngHandle As Long, _
                                      ByVal strFolder As String) As Boolean
    Dim DelFileOp As SHFILEOPSTRUCT
    Dim result As Long
    Dim strP As String
On Error GoTo errSub
    funDeleteAllFileInFolder = False
    If Right(strFolder, 1) <> "\" Then
        strP = strFolder & "\*"
    Else
        strP = strFolder & "*"
    End If
    With DelFileOp
        .hwnd = lngHandle
        .wFunc = FO_DELETE '(删除)
        .pFrom = strP & vbNullChar & vbNullChar
        .fFlags = FOF_ALLOWUNDO
    End With
    result = SHFileOperation(DelFileOp)
    If result <> 0 Then ' Operation failed
        funDeleteAllFileInFolder = False
        If Err.LastDllError <> 0 Then
            MsgBox Err.LastDllError ' Msgbox the error that occurred in the API.
        End If
        Exit Function
    Else
        If DelFileOp.fAnyOperationsAborted <> 0 Then
            MsgBox "Operation Failed"
            Exit Function
        End If
    End If
    funDeleteAllFileInFolder = True
    Exit Function
errSub:
    funDeleteAllFileInFolder = False
End Function
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'过程功能：移动指定文件夹下的文件，相当于文件剪切粘贴
'参数说明：strFromFolder：指定的文件夹
'        ：lngHandle：执行操作的对象的句柄
'返回说明：
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
Public Function funMoveAllFileInFolder(ByVal lngHandle As Long, _
                                    ByVal strFromFolder As String, _
                                    ByVal strToFolder As String) As Boolean
    Dim DelFileOp As SHFILEOPSTRUCT
    Dim result As Long
    Dim strP As String
    Dim strT As String
On Error GoTo errSub
    funMoveAllFileInFolder = False
    If Right(strFromFolder, 1) <> "\" Then
        strP = strFromFolder & "\*"
    Else
        strP = strFromFolder & "*"
    End If
    If Right(strToFolder, 1) = "\" Then
        strT = Left(strToFolder, Len(strToFolder) - 1)
    Else
        strT = strToFolder
    End If
    With DelFileOp
        .hwnd = lngHandle
        .wFunc = FO_MOVE '(删除)
        .pFrom = strP & vbNullChar & vbNullChar
        .pTo = strT
        .fFlags = FOF_ALLOWUNDO
    End With
    result = SHFileOperation(DelFileOp)
    If result <> 0 Then             ' Operation failed
        If Err.LastDllError <> 0 Then
            MsgBox Err.LastDllError ' Msgbox the error that occurred in the API.
        End If
        Exit Function
    Else
        If DelFileOp.fAnyOperationsAborted <> 0 Then
            MsgBox "Operation Failed"
            Exit Function
        End If
    End If
    funMoveAllFileInFolder = True
    Exit Function
errSub:
    funMoveAllFileInFolder = False
End Function'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'过程功能：复制指定文件夹下的文件，相当于文件复制粘贴
'参数说明：strFromFolder：指定的文件夹
'        ：lngHandle：执行操作的对象的句柄
'返回说明：
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
Public Function funCopyAllFileInFolder(ByVal lngHandle As Long, _
                                    ByVal strFromFolder As String, _
                                    ByVal strToFolder As String) As Boolean
    Dim DelFileOp As SHFILEOPSTRUCT
    Dim result As Long
    Dim strP As String
    Dim strT As String
On Error GoTo errSub
    funCopyAllFileInFolder = False
    If Right(strFromFolder, 1) <> "\" Then
        strP = strFromFolder & "\*"
    Else
        strP = strFromFolder & "*"
    End If
    If Right(strToFolder, 1) = "\" Then
        strT = Left(strToFolder, Len(strToFolder) - 1)
    Else
        strT = strToFolder
    End If
    With DelFileOp
        .hwnd = lngHandle
        .wFunc = FO_COPY
        .pFrom = strP & vbNullChar & vbNullChar
        .pTo = strT
        .fFlags = FOF_ALLOWUNDO
    End With
    result = SHFileOperation(DelFileOp)
    If result <> 0 Then             ' Operation failed
        If Err.LastDllError <> 0 Then
            MsgBox Err.LastDllError ' Msgbox the error that occurred in the API.
        End If
        Exit Function
    Else
        If DelFileOp.fAnyOperationsAborted <> 0 Then
            MsgBox "Operation Failed"
            Exit Function
        End If
    End If
    funCopyAllFileInFolder = True
    Exit Function
errSub:
    funCopyAllFileInFolder = False
End Function