VB6 converts MHT to Doc

Source: Internet
Author: User

VB6 converts MHT to Doc. in the previous article, only word can be produced. Although the suffix of Doc is actually MHT encoding, uploading to Baidu Library will encounter document recognition errors, below we will use VB6 to convert the document. In fact, it is very simple to open and save it as, and call the word component, so the speed is very slow, there is no good solution for the moment

 

Dim wordapp as object <br/> dim worddoc as object <br/> dim paths (200) as string <br/> dim names (200) as string <br/> dim cpath as string </P> <p> function doword (filepath, names) <br/> openword (filepath) <br/> B = saveasword (cpath, names) <br/> 'B = saveasword ("D:/www/cword/word", names) <br/> end function </P> <p> function openword (filename) 'open a specified Word file </P> <p> set wordapp = Createobject ("word. application ") <br /> Wordapp. visible = false <br/> set worddoc = wordapp. documents. open (filename) <br/> end function </P> <p> '= br/> function replaceword (searchstr, replacestr) 'replace all functions <br/> wordapp. selection. find. clearformatting <br/> wordapp. selection. find. replacement. clearformatting <br/> with wordapp. selection. find <br/>. TEXT = searchstr <br/>. replacement. TEXT = replacestr <br/>. forward = True <br/>. wrap = wdfindcontinue <br/>. format = false <br/>. matchcase = false <br/>. matchwholeword = false <br/>. matchbyte = true <br/>. matchwildcards = false <br/>. matchsoundslike = false <br/>. matchallwordforms = false <br/> end with <br/> wordapp. selection. find. execute replace: = wdreplaceall <br/> end function </P> <p> '====================== ================< br/> function saveasword (DIS Kstr, namestr) </P> <p> wordapp. changefileopendirectory diskstr <br/> worddoc. saveas filename: = namestr, fileformat: = wdformatdocument _ <br/>, lockcomments: = false, password: = "", addtorecentfiles: = true, _ <br/> writepassword: = "", readonlyrecommended: = false, embedtruetypefonts: = false, _ <br/> savenativepictureformat: = false, saveformsdata: = false, saveasaoceletter: = _ <br/> false <br/> wordapp. documents. Close <br/> wordapp. quit </P> <p> end function </P> <p> '============================ clear object = ===========< br/> function closeword () <br/> set worddoc = nothing 'clear file instances <br/> set wordapp = nothing' clear word instances <br/> end function </P> <p> private sub command2_click () <br/> label1.visible = true <br/> label1.caption = "converted" & searchfiles (cpath ,"*. doc ") &" article "</P> <p> end sub </P> <p> function searchfiles (path as string, filetype S string) <br/> dim files () as string 'file path <br/> dim folder () as string' folder path <br/> dim A, B, c As long </P> <p> dim Spath as string </P> <p> Spath = Dir (Path & filetype) 'Find the first file <br/> I = 0 <br/> do while Len (Spath) 'until no file exists. <br/> A = a + 1 <br/> redim preserve files (1 to A) <br/> files () = Path & Spath combines the file directory and file name and puts them in the array <br/> 'processing <br/> A = doword (Files (A), Spath) <br/> '<br/> 'text1. TEXT = files (A) <br/> 'paths (I) = files (a) <br/> 'names (I) = Spath list1.additem paths (I) 'Add the list control <br/> I = I + 1 <br/> label1.caption = "generating" & I <br/> Spath = dir' to find the next file <br/> doevents 'give Control <br/> loop </P> <p> Spath = Dir (Path &"/", vbdirectory) 'Find the first folder </P> <p> do while Len (Spath) 'until there is no folder <br/> if left (Spath, 1) <> ". "then' to prevent repeated searches <br/> If getattr (Path &"/"& Spath) and vbdirectory then' if it is a folder ...... <Br/> B = B + 1 <br/> redim preserve folder (1 to B) <br/> folder (B) = Path & Spath & "/" 'combines the Directory and folder name to form a new directory, save and put it in the array <br/> end if <br/> Spath = dir' to find the next folder <br/> doevents 'to give control <br/> Loop </P> <p> for C = 1 to B 'use the recursive method, traverse all directories <br/> searchfiles folder (c ), filetype <br/> next <br/> searchfiles = I <br/> end function </P> <p> private sub dir1_change () <br/> cpath = dir1.path + "/" </P> <p> end sub </P> <p> private sub driveappschange () <br/> dir1.path = drive1.drive </P> <p> end sub <br/>

There are a lot of useless codes in PS code, which are used during testing, so I am too lazy to optimize them.

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.