www.pudn.com > VB-EMAIL-SUBMIT-SYS.rar > Form1.frm, change:2014-10-12,size:15530b


VERSION 5.00 
Object = "{20C62CAE-15DA-101B-B9A8-444553540000}#1.1#0"; "MSMAPI32.OCX" 
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx" 
Begin VB.Form Form1  
   Caption         =   "Email Information Generation System" 
   ClientHeight    =   8595 
   ClientLeft      =   60 
   ClientTop       =   450 
   ClientWidth     =   8295 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   8595 
   ScaleWidth      =   8295 
   StartUpPosition =   3  '窗口缺省 
   Begin VB.ComboBox Combo1  
      Height          =   300 
      Left            =   1800 
      TabIndex        =   1 
      Text            =   "相关SWO号" 
      Top             =   4080 
      Width           =   1695 
   End 
   Begin VB.TextBox Text2  
      Height          =   360 
      Index           =   4 
      Left            =   1800 
      MouseIcon       =   "Form1.frx":0000 
      MultiLine       =   -1  'True 
      ScrollBars      =   2  'Vertical 
      TabIndex        =   19 
      Text            =   "Form1.frx":030A 
      Top             =   6720 
      Width           =   4455 
   End 
   Begin VB.CommandButton Command3  
      Caption         =   "Open" 
      Height          =   375 
      Left            =   6480 
      TabIndex        =   17 
      Top             =   6720 
      Width           =   615 
   End 
   Begin MSComDlg.CommonDialog CommonDialog1  
      Left            =   3240 
      Top             =   2640 
      _ExtentX        =   847 
      _ExtentY        =   847 
      _Version        =   393216 
   End 
   Begin VB.TextBox Text2  
      Height          =   255 
      Index           =   3 
      Left            =   1800 
      MouseIcon       =   "Form1.frx":0328 
      ScrollBars      =   2  'Vertical 
      TabIndex        =   16 
      Text            =   "附件名称 Attachment Name" 
      Top             =   6240 
      Width           =   4095 
   End 
   Begin VB.CommandButton Command2  
      Caption         =   "Get Detail Info." 
      BeginProperty Font  
         Name            =   "Calibri" 
         Size            =   9.75 
         Charset         =   0 
         Weight          =   700 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   495 
      Left            =   1920 
      TabIndex        =   14 
      Top             =   7440 
      Width           =   975 
   End 
   Begin VB.TextBox Text2  
      Height          =   1695 
      Index           =   1 
      Left            =   1800 
      MouseIcon       =   "Form1.frx":0632 
      MultiLine       =   -1  'True 
      ScrollBars      =   2  'Vertical 
      TabIndex        =   12 
      Text            =   "Form1.frx":093C 
      Top             =   4440 
      Width           =   5775 
   End 
   Begin VB.TextBox Text2  
      Height          =   375 
      Index           =   0 
      Left            =   1800 
      TabIndex        =   11 
      Text            =   "外委工作跟踪报告及跟进要求" 
      Top             =   3240 
      Width           =   4095 
   End 
   Begin VB.TextBox Text1  
      Height          =   375 
      Index           =   4 
      Left            =   1800 
      TabIndex        =   9 
      Text            =   "sheng.chen" 
      Top             =   2040 
      Width           =   3975 
   End 
   Begin VB.TextBox Text1  
      Height          =   375 
      Index           =   3 
      Left            =   1800 
      TabIndex        =   8 
      Text            =   "sheng.chen" 
      Top             =   1560 
      Width           =   3975 
   End 
   Begin VB.TextBox Text1  
      Height          =   375 
      Index           =   2 
      Left            =   1800 
      TabIndex        =   7 
      Text            =   "sheng.chen" 
      Top             =   1080 
      Width           =   3975 
   End 
   Begin VB.TextBox Text1  
      Height          =   375 
      Index           =   1 
      Left            =   1800 
      TabIndex        =   5 
      Text            =   "sheng.chen" 
      Top             =   600 
      Width           =   3975 
   End 
   Begin MSMAPI.MAPIMessages MAPIMessages1  
      Left            =   2040 
      Top             =   2520 
      _ExtentX        =   1005 
      _ExtentY        =   1005 
      _Version        =   393216 
      AddressEditFieldCount=   1 
      AddressModifiable=   0   'False 
      AddressResolveUI=   0   'False 
      FetchSorted     =   0   'False 
      FetchUnreadOnly =   0   'False 
   End 
   Begin MSMAPI.MAPISession MAPISession1  
      Left            =   600 
      Top             =   2520 
      _ExtentX        =   1005 
      _ExtentY        =   1005 
      _Version        =   393216 
      DownloadMail    =   -1  'True 
      LogonUI         =   -1  'True 
      NewSession      =   0   'False 
   End 
   Begin VB.TextBox Text1  
      Height          =   375 
      Index           =   0 
      Left            =   1800 
      TabIndex        =   2 
      Text            =   "sheng.chen" 
      Top             =   120 
      Width           =   3975 
   End 
   Begin VB.CommandButton Command1  
      Caption         =   "Sent Info to Target" 
      BeginProperty Font  
         Name            =   "Calibri" 
         Size            =   11.25 
         Charset         =   0 
         Weight          =   700 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   495 
      Left            =   4080 
      TabIndex        =   0 
      Top             =   7440 
      Width           =   3255 
   End 
   Begin VB.Label Label3  
      Caption         =   "邮件关联选择Select Email Topic:" 
      Height          =   375 
      Index           =   2 
      Left            =   480 
      TabIndex        =   20 
      Top             =   3840 
      Width           =   3495 
   End 
   Begin VB.Label Label4  
      Caption         =   "附件地址" 
      Height          =   375 
      Index           =   1 
      Left            =   600 
      TabIndex        =   18 
      Top             =   6720 
      Width           =   1095 
   End 
   Begin VB.Label Label4  
      Caption         =   "附件名称" 
      Height          =   375 
      Index           =   0 
      Left            =   600 
      TabIndex        =   15 
      Top             =   6240 
      Width           =   1095 
   End 
   Begin VB.Label Label3  
      Caption         =   "邮件内容:" 
      Height          =   255 
      Index           =   1 
      Left            =   600 
      TabIndex        =   13 
      Top             =   4440 
      Width           =   1215 
   End 
   Begin VB.Label Label3  
      Caption         =   "邮件标题:" 
      Height          =   255 
      Index           =   0 
      Left            =   480 
      TabIndex        =   10 
      Top             =   3240 
      Width           =   1215 
   End 
   Begin VB.Label Label1  
      Caption         =   "收件人 To:" 
      Height          =   255 
      Index           =   1 
      Left            =   600 
      TabIndex        =   6 
      Top             =   600 
      Width           =   1215 
   End 
   Begin VB.Label Label2  
      Caption         =   "收件人 CC:" 
      Height          =   255 
      Left            =   600 
      TabIndex        =   4 
      Top             =   1200 
      Width           =   1215 
   End 
   Begin VB.Label Label1  
      Caption         =   "收件人 To:" 
      Height          =   255 
      Index           =   0 
      Left            =   600 
      TabIndex        =   3 
      Top             =   240 
      Width           =   1215 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Dim excel_App As Excel.Application 
Dim excel_Book As Excel.Workbook 
Dim excel_sheet As Excel.Worksheet 
Dim i As Integer 
Dim address As String 
 
 
 
Private Sub Command1_Click() 
'On Error Resume Next 
'MAPI constants from CONSTANT.TXT file: 
      Const SESSION_SIGNON = 1 
      Const MESSAGE_COMPOSE = 6 
    '  Const ATTACHTYPE_DATA = 0 
      Const RECIPTYPE_TO = 1 
      Const RECIPTYPE_CC = 2 
      Const MESSAGE_RESOLVENAME = 13 
      Const MESSAGE_SEND = 3 
      Const SESSION_SIGNOFF = 2 
 
      'Open up a MAPI session: 
      MAPISession1.Action = SESSION_SIGNON 
      'Point the MAPI messages control to the open MAPI session: 
      MAPIMessages1.SessionID = Form1.MAPISession1.SessionID 
 
      MAPIMessages1.Action = MESSAGE_COMPOSE   'Start a new message 
 
      'Set the subject of the message: 
      MAPIMessages1.MsgSubject = Text2(0).Text 
      'Set the message content: 
      MAPIMessages1.MsgNoteText = Text2(1).Text 
 
      'The following four lines of code add an attachment to the message, 
      'and set the character position within the MsgNoteText where the 
      'attachment icon will appear. A value of 0 means the attachment will 
      'replace the first character in the MsgNoteText. You must have at 
      'least one character in the MsgNoteText to be able to attach a file. 
 
      'Set the type of attachment: 
      'Set the icon title of attachment: 
      'MAPIMessages1.AttachmentName = Text2(3).Text'不定义附件名使用路径内的原文件名 
      'Set the path and file name of the attachment: 
      If InStr(Text2(1), "Click Get Detail Info") Then 
      MsgBox "没有填写具体内容" 
      Exit Sub 
      ElseIf InStr(Text2(4), "附件地址") Then 
      MsgBox "无附件" 
      Else 
     Const ATTACHTYPE_DATA = 0 
           MAPIMessages1.AttachmentPosition = 0 
           MAPIMessages1.AttachmentType = ATTACHTYPE_DATA 
          MAPIMessages1.AttachmentPathName = Text2(4).Text 
      End If 
      
      'Set the recipients 
      MAPIMessages1.RecipIndex = 0                    'First recipient 
      MAPIMessages1.RecipType = RECIPTYPE_TO          'Recipient in TO line 
      MAPIMessages1.RecipDisplayName = Text1(0).Text   'e-mail name 
      'MAPIMessages1.RecipIndex = 1                  'add a second recipient 
      'MAPIMessages1.RecipType = RECIPTYPE_TO        'Recipient in TO line 
      'MAPIMessages1.RecipDisplayName = Text1(1).Text     'e-mail name 
      'End If 
line1: 
      MAPIMessages1.RecipIndex = 1                   'Add a third recipient 
      MAPIMessages1.RecipType = RECIPTYPE_CC         'Recipient in CC line 
      MAPIMessages1.RecipDisplayName = Text1(2).Text  'e-mail name 
      'MAPIMessages1.RecipIndex = 3                  'Add a fourth recipient 
      'MAPIMessages1.RecipType = RECIPTYPE_CC          'Recipient on CC Line 
      'MAPIMessages1.RecipDisplayName = Text1(3).Text 'e-mail name" 
 
      'MESSAGE_RESOLVENAME checks to ensure the recipient is valid and puts 
      'the recipient address in MapiMessages1.RecipAddress 
      'If the E-Mail name is not valid, a trappable error will occur. 
      MAPIMessages1.Action = MESSAGE_RESOLVENAME 
      'Send the message: 
      MAPIMessages1.Action = MESSAGE_SEND 
 
      'Close MAPI mail session: 
      MAPISession1.Action = SESSION_SIGNOFF 
End Sub 
 
Private Sub Command2_Click() 
On Error GoTo Line 
'要在VB中操作Excel,需要引用Excel对象模型 
'方法,在菜单里选择[工程] -- [引用],在窗口里勾选 Microsoft Excel XX.X Object Library 
'其中,XX.X取决于你安装的Office的版本号 
  
'在你的显示按钮中加入以下代码。 
'注:"地址"中加入你的excel文件地址,如"C:\1.XLS",要带双引号 
'Sheet1也可以改为你的工作表的名字,要带双引号 
 
Dim SWO, PN, SN, 完整度, Discription, QTY, PR 
'启动Excel 
Set excel_App = CreateObject("Excel.Application")    '引用程序对象实例 
'设置Excel为不可见 
excel_App.Visible = False 
'打开文件 
address = App.Path 
address = Mid(address, 1, InStrRev(address, "\")) 
Set excel_Book = excel_App.Workbooks.Open(address & "\外委工作跟踪(最新).xls")  '工作簿实例 
Set excel_sheet = excel_Book.Worksheets("Arrive Part list")    '数据表实例 
 
'这里需要先将你的车号存入valuesearch变量才能搜索 
valuesearch = Form1.Combo1.Text 
  
'进行搜索,存入SWO变量 
SWO = Application.WorksheetFunction.VLookup(valuesearch, Range("G:J"), 2, False) 
If SWO = "" Then 
SWO = "未填写完成" 
End If 
完整度 = Application.WorksheetFunction.VLookup(valuesearch, Range("G:K"), 4, False) 
PN = Application.WorksheetFunction.VLookup(valuesearch, Range("G:K"), 5, False) 
CN = Application.WorksheetFunction.VLookup(valuesearch, Range("G:L"), 6, False) 
Description = Application.WorksheetFunction.VLookup(valuesearch, Range("G:M"), 7, False) 
QTY = Application.WorksheetFunction.VLookup(valuesearch, Range("G:N"), 8, False) 
PR = Application.WorksheetFunction.VLookup(valuesearch, Range("G:O"), 9, False) 
 
  
'然后将SWO赋值给你的皮重文本框 
Form1.Text2(1).Text = "Dear " & Text1(0).Text & ":" & Chr(13) & Chr(10) _ 
& "Please follow the action required as below:" & Chr(13) & Chr(10) _ 
& valuesearch & " 完成状态Summary:" & Chr(13) & Chr(10) _ 
& "1: " & excel_sheet.Cells(2, 8) & ": " & SWO & Chr(13) & Chr(10) _ 
& "2: " & excel_sheet.Cells(2, 10) & ": " & 完整度 & Chr(13) & Chr(10) _ 
& "3: " & excel_sheet.Cells(2, 11) & ": " & PN & "等!" & Chr(13) & Chr(10) _ 
& "4: " & excel_sheet.Cells(2, 12) & ": " & SN & "等!" & Chr(13) & Chr(10) _ 
& "5: " & excel_sheet.Cells(2, 13) & ": " & Discription & Chr(13) & Chr(10) _ 
& "6: " & excel_sheet.Cells(2, 14) & ": " & QTY & Chr(13) & Chr(10) _ 
& "7: " & excel_sheet.Cells(2, 15) & ": " & PR & "等!" & Chr(13) & Chr(10) _ 
& Chr(13) & Chr(10) _ 
& Chr(13) & Chr(10) _ 
& Chr(13) & Chr(10) _ 
& "Rgds" _ 
& Chr(13) & Chr(10) _ 
& Date 
 
 
Line: 
''''''''''''''''''''''''''''''''''' 
'关闭Excel文件 
excel_Book.Save '保存当前工作表,使之前的数据能够被检索 
Set excel_sheet = Nothing 
Set excel_Book = Nothing 
excel_App.Quit 
Set excel_App = Nothing 
End Sub 
 
Private Sub Command3_Click() 
CommonDialog1.ShowOpen 
Text2(4).Enabled = True 
Text2(4).Text = CommonDialog1.FileName 
End Sub 
 
Private Sub Form_Load() 
Text2(4).Enabled = False 
 
Set excel_App = CreateObject("Excel.Application")    '引用程序对象实例 
'设置Excel为不可见 
excel_App.Visible = False 
'打开文件 
address = App.Path 
address = Mid(address, 1, InStrRev(address, "\")) 
Set excel_Book = excel_App.Workbooks.Open(address & "\外委工作跟踪(最新).xls")    '工作簿实例 
Set excel_sheet = excel_Book.Worksheets("Background")    '数据表实例 
'For i = 2 To 5 
'MsgBox excel_sheet.Cells(2, 2) 
Text1(0).Text = excel_sheet.Cells(2, 2) '收件人 
Text1(2).Text = excel_sheet.Cells(3, 2) 'CC 
Text1(3).Text = excel_sheet.Cells(4, 2) 'CC 
Text2(0).Text = excel_sheet.Cells(8, 2) & Date '邮件题目 
Set excel_sheet = excel_Book.Worksheets("Arrive part list") 
' 
 
'Next 
For i = 1 To excel_sheet.[a65536].End(xlUp).Row 
If Application.WorksheetFunction.CountIf(Range("G3:G" & i), Range("G" & i + 3)) = 1 Then 
Combo1.AddItem excel_sheet.Cells(i, 7) 
End If 
Next i 
Combo1.Text = excel_sheet.Cells(1, 19) 
Call Command2_Click 
End Sub 
 
 
Private Sub Form_Unload(Cancel As Integer) 
Set excel_App = CreateObject("Excel.Application")    '引用程序对象实例 
'设置Excel为不可见 
'excel_App.Visible = False 
'打开文件 
'Set excel_Book = excel_App.Workbooks.Open(App.Path & "\存档文件\外委工作跟踪(最新).xls")  '工作簿实例 
'Set excel_sheet = excel_Book.Worksheets("Arrive Part list")    '数据表实例 
Set excel_sheet = Nothing 
Set excel_Book = Nothing 
excel_App.Quit 
Set excel_App = Nothing 
End Sub