Question

当新邮件到达时，我尝试将部分电子邮件信息导出为excel。我有一个打开excel但不写任何内容的代码。请帮我解决这个问题。

这是我的代码：

Sub Extract()
  On Error Resume Next

  Set myOlApp = CreateObject("Outlook.Application")
  Set mynamespace = myOlApp.GetNamespace("mapi")

  'Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
  'MsgBox "Click YES if your have selected the correct mail folder. Else select NO", vbYesNo, "Message"

  Set xlobj = CreateObject("excel.application")
  xlobj.Visible = True
  xlobj.Workbooks.Open ("C:\script\test1.xlsm")
  xlobj.Sheets("rsadata").Select

  'xlobj.Workbooks.Add

  'Event Category
  bs = InStr(msgtext, "Event Category") + 16
  be = InStr(bs, msgtext, "Current Severity")-3
  b = Mid(msgtext, bs, be - bs)
  b = Trim(b)

  'Destination IP
  If Instr(msgtext,"Destination IP")>0 Then
    cs = InStr(msgtext, "Destination IP") + 16
    ce = InStr(cs, msgtext, "Destination Port")-3
    c = Mid(msgtext, cs, ce - cs)

    If (Len(c) < 5 ) Then
      cs = InStr(msgtext, "Device IP") + 11
      ce = InStr(cs+10, msgtext, "Device")-3
      c = Mid(msgtext, cs, ce - cs)
    End If
  Else
    cs = InStr(msgtext, "Device IP") + 11
    ce = InStr(cs+10, msgtext, "Device")-3
    c = Mid(msgtext, cs, ce - cs)
  End If

  If InStr(c, "10.181.") > 0 Or InStr(c, "10.180.") > 0 Then
    region = "US"
  ElseIf InStr(c, "10.182.") > 0 Then
    region = "AUS"
  ElseIf InStr(c, "10.204.") > 0 Then
    region = "EUR"
  ElseIf InStr(c, "10.205.") > 0 Then
    region = "IND- On Premise"
  ElseIf InStr(c, "10.56.") > 0 Or InStr(c, "10.112.") > 0 Then
    region = "IND- Airtel"
  ElseIf InStr(c, "192.168.") > 0 Then
    region = "AUS"
  Else
    region="unknown"
  End If

  If Instr(region,"unknown")>0 Then
    cs = InStr(msgtext, "Device IP") + 11
    ce = InStr(cs+10, msgtext, "Device")-3
    c = Mid(msgtext, cs, ce - cs)

    If InStr(c, "10.181.") > 0 Or InStr(c, "10.180.") > 0 Then
      region = "US"
    ElseIf InStr(c, "10.182.") > 0 Then
      region = "AUS"
    ElseIf InStr(c, "10.204.") > 0 Then
      region = "EUR"
    ElseIf InStr(c, "10.205.") > 0 Then
      region = "IND- On Premise"
    ElseIf InStr(c, "10.56.") > 0 Or InStr(c, "10.112.") > 0 Then
      region = "IND- Airtel"
    ElseIf InStr(c, "192.168.") > 0 Then
      region = "AUS"
    Else
      region="unknown"
    End If
  End If

  'Message Text
  es = InStr(msgtext, "Message Text") + 12
  ee = InStr(es, msgtext, "Alert ID")
  e = Trim(Mid(msgtext, es, ee - es))

  If InStr(e, "Account Name") >0 Then
    acnts=Instr(e,"Account Name:")+14
    acns=Instr(acnts,e,"Account Name:") + 13
    acne=Instr(acns,e,"Account Domain:")
    acn=Trim(Mid(e,acns,acne-acns))
  ElseIf  Instr(e," user=")>0 Then
    acns=Instr(e," user=")+6
    acne=Len(e)
    acn=Trim(Mid(e,acns,acne-acns))
  ElseIf Instr(e,"Invalid user")>0 Then
    acns=Instr(e,"Invalid user")+12
    acne= Instr(acns,e,"from")
    acn= Trim(Mid(e,acns,acne-acns))
  ElseIf Instr(e,"Administrator=")>0 Then
    acns=Instr(e,"Administrator=")+14
    acne=Instr(acns,e,",Client=")
    acn=Trim(Mid(e,acns,acne-acns))
  ElseIf Instr(e,"UserName=")>0 Then
    acns=Instr(e,"UserName=")+9
    acne=Instr(acns,e,",")
    acn=Trim(Mid(e,acns,acne-acns))
  ElseIf Instr(e,"CLOCKUPDATE")> 0 Then
    acn="Clock Update"
  ElseIf Instr(e,"console by")>0 Then
    acns=Instr(e,"console by ")+11
    acne=Instr(acns,e," on")
    acn=Trim(mid(e,acns,acne-acns))
  ElseIf Instr(e,"Administrator Login")>0 Then
    acn="Administrator"
  Else
    acn="Unknown"
  End If

  If Instr(acn,"/") > 0 Then
    acns=Instr(acn,"/") + 1
    acne= Len(acn)
    acn=Mid(acn,acns,acne-acns)
  End If

  If Instr(msgtext,"Correlation Message ID") >0 Then
    ks=Instr(msgtext,"Correlation Message ID")+24
    ke=Instr(ks+10,msgtext,"Correlation")-3
    k=Mid(msgtext,ks,ke-ks)
  End If

  bs=be=b=cs=ce=c=es=ee=e=acnts=acns=acne=acn=ks=ke=k=region=""
End Sub

将电子邮件信息导出到Excel

0 个答案: