Excel到Outlook:.Send返回运行时错误

时间:2018-11-07 21:08:41

标签: excel vba outlook runtime-error

这已经被问过了,但是,我已经测试了所提供的所有先前解决方案,但是没有一个起作用,所以我在这里问。

我有一个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

我已经尝试了几种在线建议的解决方案,包括:

  1. 检查我的信任中心设置-已按照this image中的设置进行设置。
  2. 使用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"
  3. 使用.SendKeys "^{ENTER}"
  4. 启用与Microsoft脚本运行时,Outlook和对象库相关的所有引用(在Excel中)
  5. 在打开Outlook和关闭Outlook的情况下运行代码
  6. 我避免使用邮件合并解决方案,因为该excel可以供多人使用,每个人都具有相同的信任中心设置,但邮件合并设置不同

我在多个宏中都具有这种电子邮件自动化功能,但是它们都无法正常工作。自从我上次使用此Excel以来,我的安全性尚未更改,并且计算机没有进行重大更新。如果有人有任何可以帮助我的补丁或信息-其中不包含或仅重复了我已经测试过的解决方案,那么我将不胜感激。我在mrexcel.com/forum上询问了有关类似但不同的代码的问题,由于我尚未收到任何答案,因此正在向我伸出援手。

编辑:

以下是有关我在Excel中的引用的更多信息:

References

3 个答案:

答案 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;
}