在 Outlook VBScript 中获取"Remote server machine does not exist or not available"

Question

我已经在Outlook VBScript上写了，该文章从Outlook下载了附件。但是现在我遇到了一个错误

远程服务器计算机不存在或不可用

我几次会遇到此错误，有时此代码运行而没有任何错误。我能够跟踪确切的失败点。该行是

Set olns = olApp.GetNameSpace("MAPI")

我几乎尝试了一切，但我无法找到解决方案。

Set Arg = WScript.Arguments
Dim item1
Dim objsubject
Dim intcount
Dim i
Dim savename
Dim vTextFile
Dim filename
Dim extension
Dim t
Dim Itimestamp
Dim savefolder
Dim vSenderEmailAddress
Dim vFlagTextFileCreate
vFlagTextFileCreate = True
savefolder = "C:UsersSANxSAxAABOTDEVDocumentsAutomation Anywhere FilesAutomation AnywhereMy TasksThrdOutlookTest"
vTextFile = savefolder & "File Report.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then    'Could not get instance of Outlook, so create a new one
    Err.Clear
    Set olApp = CreateObject("Outlook.Application")
End If
On Error Goto 0
Set olns = olApp.GetNameSpace("MAPI")
olns.Logon "Outlook", , False, True
Set objFolder = olns.GetDefaultFolder(6)
'objFolder.InAppFolderSyncObject = True
'syc.Start
For Each item1 In objFolder.Items
    If item1.Unread = True Then
        objsubject = item1.Subject
        If InStr(UCase(objsubject) ,"RPA BOT") Then
            intCount = item1.Attachments.Count
            If intcount > 0 Then
                For i = 1 To intcount
                    If InStr(item1.Attachments(i).filename, ".xls") Then
                        t = Now()
                        'Adding timestamp to the file to make it unique
                        Itimestamp = Right("0" & Hour(t), 2) & _
                                     Right("0" & Minute(t), 2) & _
                                     Right("0" & Second(t), 2)
                        fileName   = Left(item1.Attachments(i).filename, InStr(item1.Attachments(i).filename, ".xl") - 1)
                        extension  = Right(item1.Attachments(i).filename, Len(item1.Attachments(i).filename) - InStr(item1.Attachments(i).filename, ".xl"))
                        savename   = saveFolder & "" & fileName & "_" & Itimestamp & "." & extension
                        item1.Attachments(i).SaveAsFile savename
                        WScript.Sleep 1000
                        If item1.SenderEmailType = "SMTP" Then
                            vSenderEmailAddress = item1.SenderEmailAddress
                        ElseIf item1.SenderEmailType = "EX" Then
                            vSenderEmailAddress = item1.Sender.GetExchangeUser.PrimarySmtpAddress
                        End If 'If item1.SenderEmailType
                        'Create InfoFile If does not exist
                        If vFlagTextFileCreate = True Then
                            vFlagTextFileCreate = False
                            fso.CreateTextFile vTextFile
                        End If
                        Set ts = fso.OpenTextFile(vTextFile, 8, True, 0)
                        ts.WriteLine fileName & "_" & Itimestamp & "." & extension & "|" & item1.Subject & "|" & vSenderEmailAddress & vbLf
                        ts.Close
                    End If 'If InStr(item1.Attachments(i).filename
                Next
                'Turning the unread mail to read
                item1.Unread = False
            End If 'If intcount > 0 Then
        End If 'If Instr(objsubject ,
    End If 'If item1.Unread=True
Next
olns.Logoff
Set olns  = Nothing
Set olApp = Nothing
WScript.Quit

我进行了一些研究，并知道这个问题可能是因为在运行脚本之前已经打开了Outlook会话。因此，我在Set fso = CreateObject("Scripting.FileSystemObject")之前添加了一个补丁以杀死所有outlook.exe会话。我有一段时间没有遇到任何错误。我不知道这是否正确。我很高兴知道您对此的反馈。

Answer 1

在创建Outlook.application的对象之前，请杀死Outlook.exe会话。我在设置fso = createObject(" scripting.filesystemobject"(之前添加了一个补丁以杀死outlook.exe会话。下面是补丁

strComputer = "."
Set Arg  = WScript.Arguments
Process = "outlook.exe"
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\" & strComputer & "rootcimv2") 
Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name like '" & Process & "%'")
For Each p in colProcess
  On Error Resume Next
          p.Terminate   
  On Error GoTo 0          
Next
SET objWMIService = Nothing
SET colProcess = Nothing