InputBoxをポップアップし、フォルダを選択してDOCXファイルを削除するVBAのコード

Question

.RTFファイルを.DOCXに変換する小さなプログラムを作成しようとしています。私はこの部分をすることに成功しました。今、同じフォルダ内の.RTFファイルを削除する入力ボックスを追加したいと思います。

新しいフォルダを作成する必要があるたびに、手動で場所を入力する必要はありません。

私はプログラム

OR

を実行したときに削除された同じフォルダから.RTFファイルを持っているどのような方法は、入力ボックスに場所を選択する方法はありますがされています。

CODE：

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

あなたは、ユーザーがよりユーザーフレンドリーな方法でフォルダを選択できるようにするには、このようなものを使用することができます。

編集 - ファイルの削除を追加しました

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