这已经被问过了,但是,我已经测试了所提供的所有先前解决方案,但是没有一个起作用,所以我在这里问。
我有一个excel代码,如果满足特定条件,它会发送电子邮件。我已经三重检查了我的数据,并且那里没有错误。现在几天前代码运行良好,突然之间,我在<FX>
<Order ATTRIBUTE1="ACTIVE" ATTRIBUTE2="CCY"/>
<Attribute NAME="N1, N2, N3" VALUE="V1,V2,V3"/>
</FX>
行上看到了Run-Time error '287': Application-defined or object-defined error.
。当我改用.Send
时,它可以正常工作,但显然我必须手动发送电子邮件。
这是我的代码:
.Display
我已经尝试了几种在线建议的解决方案,包括:
Sub mailing()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim lastrow As Long
Dim ws As Worksheet
lastrow = Worksheets("2018").Cells(Rows.Count, "Y").End(xlUp).Row
Dim rgRem1 As Range 'rg, Reminder 1
Dim rgRem2 As Range 'Reminder 2
Dim rgRem3 As Range 'Reminder 3
Dim rgAssigned As Range 'rg2, days since assigned
Set ws = Worksheets("2018")
With ws
lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
Set rgAssigned = Range(.Cells(1, "X"), .Cells(lastrow, "X"))
Set rgRem1 = Range(.Cells(1, "Y"), .Cells(lastrow, "Y"))
Set rgRem2 = Range(.Cells(1, "z"), .Cells(lastrow, "z"))
Set rgRem3 = Range(.Cells(1, "aa"), .Cells(lastrow, "aa"))
End With
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For Each cell In rgRem1
Set OutMail = OutApp.CreateItem(0)
If cell.Value = "SENDING" Then 'try with less conditions first
With OutMail
.To = Cells(cell.Row, "V").Value
.Subject = "WO# " & Cells(cell.Row, "G").Value & " - Reminder"
.Body = "Work Order: " & Cells(cell.Row, "G").Value & _
" has been assigned to you for " & Cells(cell.Row, "x").Value & " days and is not yet completed. Can you provide any updates?" & _
vbNewLine & vbNewLine & _
"Region: " & Cells(cell.Row, "B").Value & vbNewLine & _
"District: " & Cells(cell.Row, "C").Value & vbNewLine & _
"City: " & Cells(cell.Row, "D").Value & vbNewLine & _
"Atlas: " & Cells(cell.Row, "E").Value & vbNewLine & _
"Notification Number: " & Cells(cell.Row, "F").Value & vbNewLine
'.ReadReceiptRequested = True
.Send
End With
Cells(cell.Row, "Y").Value = Now
Set OutMail = Nothing
End If
Next cell
For Each cell In rgRem2
Set OutMail = OutApp.CreateItem(0)
If cell.Value = "SENDING" Then 'try with less conditions first
With OutMail
.To = Cells(cell.Row, "V").Value
.Subject = "WO# " & Cells(cell.Row, "G").Value & " - Reminder"
.Body = "Work Order: " & Cells(cell.Row, "G").Value & _
" has been assigned to you for " & Cells(cell.Row, "x").Value & " days and is not yet completed. Can you provide any updates?" & _
vbNewLine & vbNewLine & _
"Region: " & Cells(cell.Row, "B").Value & vbNewLine & _
"District: " & Cells(cell.Row, "C").Value & vbNewLine & _
"City: " & Cells(cell.Row, "D").Value & vbNewLine & _
"Atlas: " & Cells(cell.Row, "E").Value & vbNewLine & _
"Notification Number: " & Cells(cell.Row, "F").Value & vbNewLine
'.ReadReceiptRequested = True
.Send
End With
Cells(cell.Row, "z").Value = Now
Set OutMail = Nothing
End If
Next cell
For Each cell In rgRem3
Set OutMail = OutApp.CreateItem(0)
If cell.Value = "SENDING" Then 'try with less conditions first
With OutMail
.To = Cells(cell.Row, "V").Value
.Subject = "WO# " & Cells(cell.Row, "G").Value & " - Reminder"
.Body = "Work Order: " & Cells(cell.Row, "G").Value & _
" has been assigned to you for " & Cells(cell.Row, "x").Value & " days and is not yet completed. Can you provide any updates?" & _
vbNewLine & vbNewLine & _
"Region: " & Cells(cell.Row, "B").Value & vbNewLine & _
"District: " & Cells(cell.Row, "C").Value & vbNewLine & _
"City: " & Cells(cell.Row, "D").Value & vbNewLine & _
"Atlas: " & Cells(cell.Row, "E").Value & vbNewLine & _
"Notification Number: " & Cells(cell.Row, "F").Value & vbNewLine
'.ReadReceiptRequested = True
.Send
End With
Cells(cell.Row, "aa").Value = Now
Set OutMail = Nothing
End If
Next cell
'Set OutApp = Nothing 'it will be Nothing after End Sub
Application.ScreenUpdating = True
'For Each cell In rgAssigned
'If cell.Value = 25 And cell.Value <> "Completed" And cell.Value <> "Over 75 days since assigned" And cell.Value <> "" And Cells(cell.Row, "Y").Value = "" Then
'Cells(cell.Row, "Y").Value = "SENDING"
'End If
'If cell.Value = 50 And cell.Value <> "Completed" And cell.Value <> "Over 75 days since assigned" And cell.Value <> "" And Cells(cell.Row, "Z").Value = "" Then
'Cells(cell.Row, "Z").Value = "SENDING"
'End If
'If cell.Value = 75 And cell.Value <> "Completed" And cell.Value <> "Over 75 days since assigned" And cell.Value <> "" And Cells(cell.Row, "AA").Value = "" Then
'Cells(cell.Row, "AA").Value = "SENDING"
'End If
'Next cell
End Sub
(.SendKeys
和.SendKeys "%S"
).SendKeys "^{ENTER}"
我在多个宏中都具有这种电子邮件自动化功能,但是它们都无法正常工作。自从我上次使用此Excel以来,我的安全性尚未更改,并且计算机没有进行重大更新。如果有人有任何可以帮助我的补丁或信息-其中不包含或仅重复了我已经测试过的解决方案,那么我将不胜感激。我在mrexcel.com/forum上询问了有关类似但不同的代码的问题,由于我尚未收到任何答案,因此正在向我伸出援手。
编辑:
以下是有关我在Excel中的引用的更多信息:
答案 0 :(得分:1)
几年前,由于我们的电子邮件策略不允许远程发送,我遇到了同样的问题,因此我将代码添加到Outlook中以在保存时发送草稿,然后在Excel中使用.send
代替了.save
,在我的VM上,因此可以保证它不会意外发送我正在草拟的内容,因此我不建议您在正常使用的计算机上使用此功能。这是一个奇怪的解决方案,但是可以。
Outlook代码:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderDrafts).Items
Set objNS = Nothing
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
EmailOutlookDraftsMessages
End Sub
Public Sub EmailOutlookDraftsMessages()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
Set myDraftsFolder = myFolders("insight@brickworks.com.au").Folders("Drafts")
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then
myDraftsFolder.Items.Item(lDraftItem).Send
End If
Next lDraftItem
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
希望有帮助,如果被卡住,请唱歌。
答案 1 :(得分:0)
如果几天前它对您有效,则可能是被“ smtp”端口或“ ssl”验证阻止了?它也可能由isp服务器引起(如果存在)。 我可以考虑的最后一点..也许运行时服务本身属于脚本例程(如果发生的话,会有一个日志文件..) 如果发生这种情况,我会建议您重新安装Outlook运行时或调试器服务,或同时安装两者。.
答案 2 :(得分:0)
Dan Donoghue非常感谢谁创建了这段代码,并帮助我将其放置在正确的位置:Outlook VBA中的ThisOutlookSession。我对其进行了一些微调,以使其仅发送具有收件人且包含主题中包含特定文本字符串的草稿。我希望找到一种方法来对其进行调整,以便无需手动输入我的电子邮件。
public class searchEvent extends AppCompatActivity implements SwipeRefreshLayout.OnRefreshListener,
SearchView.OnQueryTextListener {
private SessionManager session;
ProgressDialog pDialog;
List<DataModel> listData = new ArrayList<DataModel>();
Adapter adapter;
SwipeRefreshLayout swipe;
ListView list_view;
public static final String url_data = "http://10.0.2.2/TriniRec/eventList.php?email=";
public static final String url_cari = "http://10.0.2.2/TriniRec/search.php?email=";
private static final String TAG = searchEvent.class.getSimpleName();
public static final String TAG_ID = "eventID";
public static final String TAG_NAMA = "name";
public static final String TAG_RESULTS = "results";
public static final String TAG_MESSAGE = "message";
public static final String TAG_VALUE = "value";
String tag_json_obj = "json_obj_req";
@Override
protected void onCreate(Bundle savedInstanceState) {
super.onCreate(savedInstanceState);
setContentView(R.layout.activity_search_event);
// session manager
session = new SessionManager(getApplicationContext());
swipe = (SwipeRefreshLayout) findViewById(R.id.swipe_refresh);
list_view = (ListView) findViewById(R.id.list_view);
adapter = new Adapter(searchEvent.this, listData);
list_view.setAdapter(adapter);
swipe.setOnRefreshListener(this);
swipe.post(new Runnable() {
@Override
public void run() {
swipe.setRefreshing(true);
callData();
}
}
);
//Adding ListView Item click Listener.
list_view.setOnItemClickListener(new AdapterView.OnItemClickListener()
{
@Override
public void onItemClick(AdapterView<?> parent, View view, int position, long id) {
Intent intent = new Intent(searchEvent.this,ShowSingleRecordActivity.class);
// Sending ListView clicked value using intent.
intent.putExtra("ListViewValue",listData.get(position).toString());
startActivity(intent);
//Finishing current activity after open next activity.
finish();
}
});
}
private void callData() {
listData.clear();
adapter.notifyDataSetChanged();
swipe.setRefreshing(true);
String email = session.getEmail();
// Creating volley request obj
JsonArrayRequest jArr = new JsonArrayRequest(url_data + email, new Response.Listener<JSONArray>() {
@Override
public void onResponse(JSONArray response) {
Log.e(TAG, response.toString());
// Parsing json
for (int i = 0; i < response.length(); i++) {
try {
JSONObject obj = response.getJSONObject(i);
DataModel item = new DataModel();
item.setEventID(obj.getString(TAG_ID));
item.setName(obj.getString(TAG_NAMA));
listData.add(item);
} catch (JSONException e) {
e.printStackTrace();
}
}
// notifying list adapter about data changes
// so that it renders the list view with updated data
adapter.notifyDataSetChanged();
swipe.setRefreshing(false);
}
}, new Response.ErrorListener() {
@Override
public void onErrorResponse(VolleyError error) {
VolleyLog.e(TAG, "Error: " + error.getMessage());
Toast.makeText(searchEvent.this, error.getMessage(), Toast.LENGTH_LONG).show();
swipe.setRefreshing(false);
}
});
// Adding request to request queue
AppController.getInstance().addToRequestQueue(jArr);
}
@Override
public void onRefresh() {
callData();
}
@Override
public boolean onQueryTextSubmit(String query) {
cariData(query);
return false;
}
@Override
public boolean onQueryTextChange(String newText) {
return false;
}