在VBA中编写代码，popup一个InputBox，select一个文件夹，并删除DOCX文件

我正在尝试制作一个将.RTF文件转换为.DOCX的小程序。 我已经设法做到这一点。 现在，我想添加一个input框来删除同一文件夹中的.RTF文件。

我不想每次必须手动input位置时，必须做一个新的文件夹。

当我运行该程序时，是否有任何方法可以删除同一文件夹中的.RTF文件

要么

有没有办法select一个input框中的位置。

码：

Sub ChangeRTFTODOCXOrTxtOrRTFOrHTML() 'with export to PDF in Word 2007 Dim fs As Object Dim oFolder As Object Dim tFolder As Object Dim oFile As Object Dim strDocName As String Dim intPos As Integer Dim locFolder As String Dim fileType As String Dim locFolderKill As String On Error Resume Next locFolder = InputBox("Enter the folder path to RTFs", "File Conversion", "") Select Case Application.Version Case Is < 12 Do fileType = UCase(InputBox("Change rtf to TXT, RTF, HTML, DOCX", "File Conversion", "DOCX")) Loop Until (fileType = "TXT" Or fileType = "RTF" Or fileType = "HTML" Or fileType = "DOCX") Case Is >= 12 Do fileType = UCase(InputBox("Change rtf to TXT, RTF, HTML, DOCX or PDF(2007+ only)", "File Conversion", "DOCX")) Loop Until (fileType = "TXT" Or fileType = "RTF" Or fileType = "HTML" Or fileType = "PDF" Or fileType = "DOCX") End Select Application.ScreenUpdating = False Set fs = CreateObject("Scripting.FileSystemObject") Set oFolder = fs.GetFolder(locFolder) 'Set tFolder = fs.CreateFolder(locFolder & "Converted") 'Set tFolder = fs.GetFolder(locFolder & "Converted") For Each oFile In oFolder.Files Dim d As Document Set d = Application.Documents.Open(oFile.Path) strDocName = ActiveDocument.Name intPos = InStrRev(strDocName, ".") strDocName = Left(strDocName, intPos - 1) ChangeFileOpenDirectory tFolder Select Case fileType Case Is = "DOCX" strDocName = strDocName & ".DOCX" ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatXMLDocument Case Is = "TXT" strDocName = strDocName & ".txt" ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatText Case Is = "RTF" strDocName = strDocName & ".rtf" ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatRTF Case Is = "HTML" strDocName = strDocName & ".html" ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatFilteredHTML Case Is = "PDF" strDocName = strDocName & ".pdf" ' *** Word 2007 users - remove the apostrophe at the start of the next line *** 'ActiveDocument.ExportAsFixedFormat OutputFileName:=strDocName, ExportFormat:=wdExportFormatPDF End Select d.Close ChangeFileOpenDirectory oFolder Next oFile Application.ScreenUpdating = True 'This is where I want to insert the InputBox to delete the .RFT files. On Error Resume Next Kill "C:\Users\maciasa\Desktop\main test\test RFTs\*.rtf" On Error GoTo 0 End Sub 

1. 项目清单

Answer 1

你可以使用这样的东西，让用户以更友好的方式select一个文件夹：

编辑 – 添加删除文件

 Sub Tester() Dim folderDialog As FileDialog, fld As String, numDel Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker) folderDialog.AllowMultiSelect = False 'user picked a folder? If folderDialog.Show() Then fld = folderDialog.SelectedItems(1) numDel = DeleteFiles(fld, "*.rtf") MsgBox numDel & " files deleted from: " & vbLf & fld End If End Sub Function DeleteFiles(theFolder As String, fileType As String) As Long Dim f, col As New Collection, rv As Long If Right(theFolder, 1) <> Application.PathSeparator Then theFolder = theFolder & Application.PathSeparator End If 'collect all matching files in the folder f = Dir(theFolder & fileType, vbNormal) Do While f <> "" col.Add theFolder & f f = Dir() Loop rv = col.Count For Each f In col Kill f Next f DeleteFiles = rv '<<return number of files deleted End Function