i trying make small program converts .rtf files .docx. have managed part. now, want add input box delete .rtf files in same folder.
i not want input location manually every time have new folder.
is there way have .rtf files same folder deleted when run program
or
is there way choose location in input box.
code:
sub changertftodocxortxtorrtforhtml() 'with export pdf in word 2007 dim fs object dim ofolder object dim tfolder object dim ofile object dim strdocname string dim intpos integer dim locfolder string dim filetype string dim locfolderkill string on error resume next locfolder = inputbox("enter folder path rtfs", "file conversion", "") select case application.version case < 12 filetype = ucase(inputbox("change rtf txt, rtf, html, docx", "file conversion", "docx")) loop until (filetype = "txt" or filetype = "rtf" or filetype = "html" or filetype = "docx") case >= 12 filetype = ucase(inputbox("change rtf 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") each ofile in ofolder.files dim d 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 = "docx" strdocname = strdocname & ".docx" activedocument.saveas filename:=strdocname, fileformat:=wdformatxmldocument case = "txt" strdocname = strdocname & ".txt" activedocument.saveas filename:=strdocname, fileformat:=wdformattext case = "rtf" strdocname = strdocname & ".rtf" activedocument.saveas filename:=strdocname, fileformat:=wdformatrtf case = "html" strdocname = strdocname & ".html" activedocument.saveas filename:=strdocname, fileformat:=wdformatfilteredhtml case = "pdf" strdocname = strdocname & ".pdf" ' *** word 2007 users - remove apostrophe @ start of next line *** 'activedocument.exportasfixedformat outputfilename:=strdocname, exportformat:=wdexportformatpdf end select d.close changefileopendirectory ofolder next ofile application.screenupdating = true 'this want insert inputbox delete .rft files. on error resume next kill "c:\users\maciasa\desktop\main test\test rfts\*.rtf" on error goto 0 end sub - list item
you can use allow user pick folder in more user-friendly way:
edit - added deleting files
sub tester() dim folderdialog filedialog, fld string, numdel set folderdialog = application.filedialog(msofiledialogfolderpicker) folderdialog.allowmultiselect = false 'user picked folder? if folderdialog.show() fld = folderdialog.selecteditems(1) numdel = deletefiles(fld, "*.rtf") msgbox numdel & " files deleted from: " & vblf & fld end if end sub function deletefiles(thefolder string, filetype string) long dim f, col new collection, rv long if right(thefolder, 1) <> application.pathseparator thefolder = thefolder & application.pathseparator end if 'collect matching files in folder f = dir(thefolder & filetype, vbnormal) while f <> "" col.add thefolder & f f = dir() loop rv = col.count each f in col kill f next f deletefiles = rv '<<return number of files deleted end function 
Comments
Post a Comment