frmtemp.frm

智能邮件管理信息系统

VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Begin VB.Form FrmTemp 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "对话框标题"
   ClientHeight    =   3720
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   4755
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3720
   ScaleWidth      =   4755
   ShowInTaskbar   =   0   'False
   Begin SHDocVwCtl.WebBrowser WebBrowser1 
      Height          =   2175
      Left            =   600
      TabIndex        =   0
      Top             =   960
      Width           =   3105
      ExtentX         =   5477
      ExtentY         =   3836
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   ""
   End
End
Attribute VB_Name = "FrmTemp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim blnOk  As Boolean

Dim objFileSystemObject As New FileSystemObject


Private Function MailBodyContent(strMailBodyFile As String) As String
    On Error Resume Next
    Me.Hide
    blnOk = False
    
    WebBrowser1.Navigate strMailBodyFile
    Do
           DoEvents
           '超时
           If blnOk Then
               WebBrowser1.Document.Charset = "gb2312"
               MailBodyContent = WebBrowser1.Document.Body.innertext
               Exit Function
           End If
    Loop
    Unload Me
End Function

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    blnOk = True
End Sub




Public Sub WriteMailBodyFile(strMailBodyFile As String, strFileName)
    Dim strAttachFilePath  As String
    
    If objFileSystemObject.FileExists(strFileName) Then
        If ShowMessageBoxEx("文件" & strFileName & "已经存在,是否覆盖?", vbYesNo + vbQuestion, "提示") = vbYes Then
            objFileSystemObject.DeleteFile strFileName, True
        End If
    End If
    
    
     '向文件里写入数据
    Dim intTemp As Integer
    
    intTemp = FreeFile
        
retry:
        On Error Resume Next
        
        Open strFileName For Output As #intTemp
        If Err Then
            GoTo retry
        End If
        Print #intTemp, MailBodyContent(strMailBodyFile)
        Close intTemp
        
End Sub