求助!网页自动保存为txt的优化
VB初学者,请教关于将网页保存为txt的办法。目的:生成一个exe文件,执行后不用弹出界面就能将设定的网页保存为txt文件,
比如访问http://,将网页保存为txt,命名为bj,其他地方的类似命名。
由于网址变化,以前做的用不了了,返回的结果都是404错误。帮忙的人联系不上了,由于得到的都是exe文件,没办法修改程序。
自己在网上早了一个网页保存为TXT的vb代码,里面的功能很多,还有分割文件等功能,但我用不到。
我只想按想要的文件名保存网页为txt,而且exe执行后不需弹出界面就能生成文件。网上下的这个生成exe后,运行时会有界面,虽然能打开网页,但是点击转换时提示错误424,需要对象。
我想请问各位前辈,我该如何修改原来的代码,才能实现我想要的功能,请指点一二,谢谢!还想问下,win7有合适的VB6.0吗?下了一个精简版,总是出问题。
程序代码:
Public StrHtml As String 'Download by http://www. Private Sub cmdAddHTML_Click() On Error Resume Next With DlgFileOpen .CancelError = True .DefaultExt = "*.htm" .DialogTitle = "添加网页文件" .Filter = "网页文件(*.htm;*.html)|*.htm;*.html" .ShowOpen If Err <> 0 Then Exit Sub List1.Enabled = True cmdHTML2TXT.Enabled = True cmdBatConvert.Enabled = True cmdSavePage.Enabled = False End With List1.AddItem DlgFileOpen.FileName '把选择的文件路径加入列表 List1.Text = "" End Sub Private Sub cmdBrowse1_Click() On Error Resume Next With DlgTXTFileOpen .CancelError = True .DefaultExt = "*.txt" .DialogTitle = "选择文本文件" .Filter = "文本文件(*.txt)|*.txt" .ShowOpen If Err <> 0 Then Exit Sub End With txtSFile.Text = DlgTXTFileOpen.FileName lblFolder.Caption = Left(DlgTXTFileOpen.FileName, Len(DlgTXTFileOpen.FileName) - 4) MkDir lblFolder.Caption '创建目标文件夹 End Sub Private Sub cmdHTML2TXT_Click() Dim FileNum As Integer, i As Integer Dim fname As String If List1.Text = "" Then MsgBox "请先选择待转换文件!" Else '写入文本文件 StrHtml = WebPage.Document.body.innertext fname = Left(List1.Text, InStr(1, List1.Text, ".") - 1) SaveFile fname End If End Sub Private Sub cmdBatConvert_Click() '批量转换List1中的文件 Dim i As Integer Dim fname As String If List1.ListCount = 0 Then MsgBox "请先添加网页文件!" Else For i = 1 To List1.ListCount BrowseIt List1.List(i - 1) MsgBox "成功转换第" & i & "个文件<" & List1.List(i - 1) & ">为TXT格式!" '提示的目的是为了使WebPage得到更新,实际上文件尚未转换 fname = Left(List1.List(i - 1), InStr(1, List1.List(i - 1), ".") - 1) SaveFile fname Next i End If End Sub Private Sub cmdSplit_Click() Dim FileName As String, FileName2 As String Dim FileSize As Long Dim SplitSize As Long Dim FileNum As Integer, FileNum2 As Integer Dim FArr() As Byte Dim n As Integer Dim i As Integer FileNum = FreeFile FileName = txtSFile.Text Open FileName For Binary As #FileNum FileSize = LOF(FileNum) '源文件大小,单位字节 SplitSize = Val(txtSize.Text) * 1024 ReDim FArr(1 To SplitSize) '重定义数组空间 If FileSize <= SplitSize Then MsgBox "源文件小于或等于单位尺寸,无须分割!" Else n = FileSize \ SplitSize If n <> FileSize / SplitSize Then n = n + 1 '计算分割份数 lblFileNum = n For i = 1 To n Get FileNum, (i - 1) * SplitSize + 1, FArr FileNum2 = FreeFile FileName2 = Right(lblFolder.Caption, InStr(StrReverse(lblFolder.Caption), "\") - 1) Open lblFolder.Caption & "\" & FileName2 & Trim(Str(i)) & ".txt" For Binary As #FileNum2 Put FileNum2, , FArr Close #FileNum2 '加入人工判断断字功能 If i > 1 Then FileNum2 = FreeFile Dim StrTest As String Dim ret As Long Open lblFolder.Caption & "\" & FileName2 & Trim(Str(i)) & ".txt" For Input As #FileNum2 Line Input #FileNum2, StrTest Close #FileNum2 ret = MsgBox("请确认分割后文件头部文字是否正确?" & Chr(13) & StrTest, vbYesNo, "汉字断开识别") If ret = vbNo Then Get FileNum, (i - 1) * SplitSize, FArr '不正确向前读一个 Kill lblFolder.Caption & "\" & FileName2 & Trim(Str(i)) & ".txt" FileNum2 = FreeFile Open lblFolder.Caption & "\" & FileName2 & Trim(Str(i)) & ".txt" For Binary As #FileNum2 Put FileNum2, , FArr Close #FileNum2 End If End If Next i End If Close #FileNum End Sub Private Sub cmdViewPage_Click() List1.Enabled = False cmdHTML2TXT.Enabled = False cmdBatConvert.Enabled = False cmdSavePage.Enabled = True WebPage.Navigate2 txtURL.Text While WebPage.Busy DoEvents Wend End Sub Private Sub cmdSavePage_Click() With DlgFileSave .CancelError = True .DefaultExt = "*.txt" .DialogTitle = "保存为文本文件" .Filter = "文本文件(*.txt)|*.txt" .ShowSave If Err <> 0 Then Exit Sub End With SaveFile DlgFileSave.FileName End Sub Private Sub Form_Load() cmdSavePage.Enabled = False End Sub Private Sub List1_Click() BrowseIt List1.Text End Sub Private Sub SaveFile(ByRef fname As String) Dim FileNum As Integer FileNum = FreeFile If fname = "" Then '规范文件名 fname = "TXT" ElseIf LCase(Right(fname, 4)) <> ".txt" Then fname = fname & ".txt" End If StrHtml = WebPage.Document.body.innertext Open fname For Output As #FileNum '保存纯文本文件,位于源html文件夹中?? Print #FileNum, StrHtml Close #FileNum End Sub Private Sub BrowseIt(page As String) WebPage.Navigate page End Sub Private Sub txtURL_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cmdViewPage_Click End Sub!
附网上的代码