求助！网页自动保存为txt的优化

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