在excel2013中寫的自動回信的代碼 由于升級win10 excel版本更新的2016。執行的時候出現automation錯誤 請求大神指點迷津（代碼中的亂碼為日文字符 請忽視）
Sub Outlookmail() Application.ScreenUpdating = False Dim nameList As Range
Dim lastRow As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim outlookApp As Object Set sht1 = ThisWorkbook.Worksheets("Namelist")
Set sht2 = ThisWorkbook.Worksheets("mail撪梕")
lastRow = sht1.Range("a1048576").End(xlUp).Row For Each nameList In sht1.Range("a2:a" & lastRow) If nameList <> "" Then Set outlookApp = CreateObject("outlook.application") Dim olNs As Outlook.Namespace Dim flDr As Outlook.MAPIFolder Dim mailReply As Outlook.MailItem Dim iTm As Outlook.MailItem Dim foldername As String foldername = ThisWorkbook.Worksheets("mail撪梕").Range("B2").Value Set outlookApp = New Outlook.Application Set olNs = outlookApp.GetNamespace("MAPI") Set flDr = olNs.GetDefaultFolder(olFolderInbox).Folders(foldername) 'Set myTasks = flDr.Items For Each iTm In flDr.Items If nameList.Value = iTm.To And iTm.Subject = "亂FMO亃愝旛専廂埶棅 Request for asset acceptance." Then Set mailReply = iTm.ReplyAll mailReply.Subject = "儕儅僀儞僪: 亂FMO亃愝旛専廂埶棅 Request for asset acceptance." mailReply.Body = sht2.Range("a2").Value + mailReply.Body mailReply.Display nameList.Offset(0, 1) = "仜" Exit For Else nameList.Offset(0, 1) = "亊" On Error Resume Next End If Next Else MsgBox "namelist傪擖椡偟偰偔偩偝偄" End If Next Set outlookApp = Nothing
Set outlookApp = Nothing
Set olNs = Nothing
Set flDr = Nothing
'Set myTasks = Nothing Application.ScreenUpdating = True End Sub
uj5u.com熱心網友回復：
有沒有大神啊 求教！uj5u.com熱心網友回復：
Sub Outlookmail()Application.ScreenUpdating = False
Dim nameList As Range
Dim lastRow As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim outlookApp As Object
Set sht1 = ThisWorkbook.Worksheets("Namelist")
Set sht2 = ThisWorkbook.Worksheets("mail撪梕")
lastRow = sht1.Range("a1048576").End(xlUp).Row
For Each nameList In sht1.Range("a2:a" & lastRow)
If nameList <> "" Then
Set outlookApp = CreateObject("outlook.application")
Dim olNs As Outlook.Namespace
Dim flDr As Outlook.MAPIFolder
Dim mailReply As Outlook.MailItem
Dim iTm As Outlook.MailItem
Dim foldername As String
foldername = ThisWorkbook.Worksheets("mail撪梕").Range("B2").Value
Set outlookApp = New Outlook.Application
Set olNs = outlookApp.GetNamespace("MAPI")
Set flDr = olNs.GetDefaultFolder(olFolderInbox).Folders(foldername)
'Set myTasks = flDr.Items
For Each iTm In flDr.Items
If nameList.Value = iTm.To And iTm.Subject = "亂FMO亃愝旛専廂埶棅 Request for asset acceptance." Then
Set mailReply = iTm.ReplyAll
mailReply.Subject = "儕儅僀儞僪: 亂FMO亃愝旛専廂埶棅 Request for asset acceptance."
mailReply.Body = sht2.Range("a2").Value + mailReply.Body
mailReply.Display
nameList.Offset(0, 1) = "仜"
Exit For
Else
nameList.Offset(0, 1) = "亊"
On Error Resume Next
End If
Next
Else
MsgBox "namelist傪擖椡偟偰偔偩偝偄"
End If
Next
Set outlookApp = Nothing
Set outlookApp = Nothing
Set olNs = Nothing
Set flDr = Nothing
'Set myTasks = Nothing
Application.ScreenUpdating = True
End Sub
uj5u.com熱心網友回復：
已經解決！謝謝[face]monkey2:005.png[/face][face]monkey2:005.png[/face]轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/236778.html
標籤：VBA