Question

我要做的是创建一个带有outlook和excel的简单跟踪/票务系统。我正在使用Office 2016.这就是我想要做的事情：

收到新电子邮件后，在Excel中启动一个宏，检查它是否是新邮件或回复/复制。如果它是新的，excel表将创建一个新条目，并分配一个票号。现在，我想将此票号附加到电子邮件主题，并向发件人发送自动回复。

我对excel vba有一些了解，但我正在努力使用Outlook部分。任何帮助或推动正确的方向将不胜感激。我试图从在线教程中提取一些信息，但我觉得有点迷失。谢谢你的帮助！

Answer 1

这段代码可以帮助您从Outlook中访问邮件的主题行。在应用代码之前，不要忘记添加＆＃34; Microsoft Outlook 15.0对象库＆＃34;的参考。

您需要做的是在访问主题行后，您可以通过＆＃34; FW：＆＃34;或者＆＃34; RE：＆＃34;检查转发的邮件或回复的邮件。

sub MailsImport()

Dim Folder As Outlook.MAPIFolder
Dim sFolders As Outlook.MAPIFolder
Dim iRow As Integer, oRow As Integer
Dim MailBoxName As String, Pst_Folder_Name  As String
Dim ProfileName As String

ProfileName = "Enter the outlook profile mail address" 'Ex: test.user@hotmail.com

'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session)
MailBoxName = ProfileName

'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
Pst_Folder_Name = "Enter the folder name in your outlook profile" 'Example: "Inbox" or "Sent Items"

'To directly a Folder at a high level
'Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)

'To access a main folder or a subfolder (level-1)
For Each Folder In Outlook.Session.Folders(MailBoxName).Folders
    If VBA.UCase(Folder.Name) = VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found
    For Each sFolders In Folder.Folders
        If VBA.UCase(sFolders.Name) = VBA.UCase(Pst_Folder_Name) Then
            Set Folder = sFolders
            GoTo Label_Folder_Found
        End If
    Next sFolders
Next Folder

Label_Folder_Found:
 If Folder.Name = "" Then
    MsgBox "Invalid Data in Input"
    GoTo End_Lbl1:
End If

'Read Through each Mail and export the details to Excel for Email Archival
ThisWorkbook.Sheets(1).Activate
Folder.Items.Sort "Received"

'Insert Column Headers
'ThisWorkbook.Sheets(1).Cells(1, 1) = "Sender"
ThisWorkbook.Sheets(1).Cells(1, 2) = "Subject"
'ThisWorkbook.Sheets(1).Cells(1, 3) = "Date"
'ThisWorkbook.Sheets(1).Cells(1, 4) = "Size"
'ThisWorkbook.Sheets(1).Cells(1, 5) = "EmailID"
'ThisWorkbook.Sheets(1).Cells(1, 1) = "Body"

'Export eMail Data from PST Folder to Excel with date and time
oRow = 1
For iRow = 1 To Folder.Items.Count
    'If condition to import mails received in last 60 days
    'To import all emails, comment or remove this IF condition
    If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then
       oRow = oRow + 1
       ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
       'ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).SenderName
       ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).Subject
       'ThisWorkbook.Sheets(1).Cells(oRow, 3) = Folder.Items.Item(iRow).ReceivedTime
       'ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).Size
       'ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress
       'ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).Body
    End If
Next iRow
Set Folder = Nothing
Set sFolders = Nothing
End_Lbl1:
End sub

对于发送邮件，您可以使用powershell代码，这非常简单：

$SmtpClient = new-object system.net.mail.smtpClient
$MailMessage = New-Object system.net.mail.mailmessage 
$SmtpServer = "your smtp servername" #Ex: mail1.hotmail.com
$SmtpClient.host = $SmtpServer 
$MailMessage.From = "Your mail id" #Ex: test.user@hotmail.com
$MailMessage.To.add("Mail id of the recipient") 
$MailMessage.Subject = "subject line for your mail"
$MailMessage.IsBodyHtml = 0

$MailMessage.Body = "//body of the mail
//body
//body
//body
//body"
$SmtpClient.Send($MailMessage)

在传入的Outlook 2016电子邮件上填充Excel工作表，并修改添加了票号的电子邮件主题

1 个答案: