删除文件夹-如何?

时间:2018-09-28 15:44:51

标签: vba directory

这是我用来删除/删除桌面上的文件夹的代码:

Option Explicit

Sub deletefiles()
Dim fso As Object
Dim folder 'As String
Dim f
Dim Name As String

On Error Resume Next

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("C:\Users\My\Desktop\PDFs")  '<-- edit path as required to match your machine

' delete all files in root folder
For Each f In folder.Files
   On Error Resume Next
   Name = f.Name
   f.Delete True

   On Error GoTo 0
Next

' delete all subfolders and files
For Each f In folder.SubFolders
   On Error Resume Next
   Name = f.Name
   f.Delete True

   On Error GoTo 0
Next

folder.Delete

End Sub

该宏执行删除文件夹中文件的工作...除了删除文件夹本身以外。直到我关闭工作簿,文件夹才真正从桌面上消失。

为什么?如何更改代码,这样我就不必先关闭工作簿?

谢谢。

ps:工作的宏不必是上面的宏。我会接受任何有效的代码。

================================================ =========================

更新

这是创建PDF,电子邮件和删除操作的全部代码:

Option Explicit

Sub pdf()
Dim wsA As Worksheet, wbA As Workbook, strTime As String
Dim strName As String, strPath As String
Dim strFile As String
Dim strPathFile As String


'On Error GoTo errHandler

    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet


'replace spaces and periods in sheet name
    strName = Replace(wsA.Name, " ", "")
    strName = Replace(strName, ".", "_")

'create default name for savng file
    'strPath = "G:\Finance\Corporate Accounting\SHIRLEY\A. Financial Planning Fee Payment Processing\"
    strPath = "C:\Users\My\Desktop\PDFs\"
    strFile = strName    '"_" & strTime & "_" & Sheets("MDM Invoice").Range("B2").Value
    strPathFile = strPath & strFile


Dim myFolder$
myFolder = Environ("UserProfile") & "\Desktop\PDFs"

If Dir(myFolder, vbDirectory) = "" Then
     MkDir myFolder
End If

'export to PDF if a folder was selected
    wsA.ExportAsFixedFormat 0, strPathFile

'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & strPathFile

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

Sub Send_Email()

Dim FileName As String
Dim strPath As String, strPath2 As String
Dim c As Range
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim i As Integer
Dim it As String

strPath = Environ("UserProfile") & "\Desktop\PDFs\"
strPath2 = Environ("UserProfile") & "\Desktop\PDFs"

    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
        With OutLookMailItem
                .To = "logitga@yahoo.com"  'c.Value
                .CC = "Your CC here"
                .Subject = "Your Subject here"
                .HTMLBody = "Your Body content here"
                FileName = Dir(strPath & "*.*")

                .Attachments.Add strPath & FileName
                .Display
                '.Send
        End With
    Next c
On Error Resume Next

Kill "C:\Users\My\Desktop\PDFs\*.*"    ' delete all files in the folder
RmDir "C:\Users\My\Desktop\PDFs"  ' delete folder
End Sub

Sub byby()
'Dim fso
'    Set fso = CreateObject("Scripting.FileSystemObject")
'    fso.DeleteFolder Environ("UserProfile") & "\Desktop\PDFs"

Kill "C:\Users\My\Desktop\PDFs\*.*"    ' delete all files in the folder
RmDir "C:\Users\My\Desktop\PDFs"  ' delete folder
End Sub

2 个答案:

答案 0 :(得分:0)

要删除文件夹,您应该使用RmDir Statement。根据文档:

  

如果您尝试在包含文件的目录或文件夹上使用RmDir,则会发生错误。在尝试删除目录或文件夹之前,请使用Kill语句删除所有文件。

所以您最终得到了一个像这样的例程:

Kill "C:\Users\My\Desktop\PDFs\*.*"    ' delete all files in the folder
RmDir "C:\Users\My\Desktop\PDFs"  ' delete folder

答案 1 :(得分:0)

对象与变体

只需将第5和6行更改为:

Dim folder As Object
Dim f As Object

这可能是由于某些复制粘贴或其他原因导致的。