Код Outlook VBA работает только на одном компьютере

Question

Итак, это одна из, возможно, странных проблем, которые у меня были до сих пор с VBA.

Я работал на макрос, который выполняет следующие действия:

1. В текущей электронной почты, он проверяет один файл XLS.
2. Если найден, сохраняет вложение во временной папке, чтобы прочитать файл.
3. Скопируйте/Вставьте определенный регион в тело электронной почты.
4. использует определенные поля в электронной почте автоматическое заполнение строки темы

Итак, у меня есть все, что для работы на компьютере, я разработал его. Работает нормально, никаких проблем. Мой босс попытался добавить его на свой компьютер, и он не работает. Он дает эту ошибку

Run Time error -382271456(e9370020) 
Cannot save the attachment 

Ниже приведен код, извините за прочитанное, я знаю, что много.

Sub Parse_Excel() 
    Dim NewMail As MailItem, oInspector As Inspector 
    Set oInspector = Application.ActiveInspector 
    Dim eAttachment As Object, i As Integer, lRow As Integer, lCol As Integer, rng As Range, subject As String 
    Dim codes As String, c As Variant, dArea As Range, dType As Range, dSev As Range, result As String, damage As String 
    Dim lCommentRowRng As Range 

    '~~> Get the current open item 
    Set NewMail = oInspector.CurrentItem 

    Set eAttachment = Excel.Application 

    With NewMail.Attachments 
     For i = 1 To .Count 

      If InStr(.Item(i).FileName, ".xls") > 0 Then 

       sFileName = Environ$("temp") & "/" & .Item(i).FileName 
       ' Creates a temporary file in the temp folders for Outlook 

       Debug.Print sFileName 
       'Used to test something 

       .Item(i).SaveAsFile sFileName 
       ' Save file there 

       eAttachment.Workbooks.Open sFileName 
       'Open the saved file - this is necessary as you can't simply open it from outlook 

       With eAttachment.Workbooks(.Item(i).FileName).Sheets(1) 

        Set lCommentRowRng = .Cells.Find("Comments") 

        Set rng = lCommentRowRng.Offset(0, 1) 
        ' Sometimes the comments will be on the bottom, so we need to have this to figure out how far down exactly the comment box goes 
        If Not lCommentRowRng.Row = (rng.Row + rng.MergeArea.Rows.Count) Then 
         lCommentRow = rng.Row + rng.MergeArea.Rows.Count 
         lCol = rng.Column + rng.MergeArea.Columns.Count - 1 
        Else 
         lCommentRow = lCommentRowRng.Row 
        End If 
        lPriorRow = .Cells.Find("Prior Inspections").Row 
        lRow = eAttachment.Max(lCommentRow, lPriorRow) 
        'The date of the report 
        Set rng = .Cells.Find("Date") 
        ddate = .Cells(rng.Row, rng.Column + rng.MergeArea.Columns.Count).Value 

        'The VIN we are using 
        result = "" 
        With .Cells 
         Set c = .Find("VIN", LookIn:=xlValues) 
         If Not c Is Nothing Then 
          firstAddress = c.Address 
          Do 

           result = result & " " & Right(c.Offset(0, 1).Value, 8) 

           Set c = .FindNext(c) 
          Loop While Not c Is Nothing And c.Address <> firstAddress 
         End If 
        End With 
        vin = result 

        'Make/Model 
        result = "" 
        With .Cells 
         Set c = .Find("Model", LookIn:=xlValues) 
         If Not c Is Nothing Then 
          firstAddress = c.Address 
          Do 

           If uInStr(result, c.Offset(0, 1).Value) = -1 Then 
            result = result & " " & c.Offset(0, 1).Value 
           End If 

           Set c = .FindNext(c) 
          Loop While Not c Is Nothing And c.Address <> firstAddress 
         End If 
        End With 
        model = result 

        Set rng = .Cells.Find("Origin") 
        ' Not all reports have Origin/Railcar Number fields, thus the If statements 
        If Not rng Is Nothing Then 
         origin = .Cells(rng.Row, rng.Column + rng.MergeArea.Columns.Count).Value 
        End If 

        Set rng = .Cells.Find("Railcar Number") 
        If Not rng Is Nothing Then 
         Railcar = .Cells(rng.Row, rng.Column + rng.MergeArea.Columns.Count).Value 
        End If 

        'Not all Reports have "Bay" Information 
        Set rng = .Cells.Find("Bay Location") 
        If Not rng Is Nothing Then 
         bay = rng.Offset(0, 1).Value 
        End If 


        result = "" 
        'The result variable, that will hold the string for the top 
        With .Cells 
         Set c = .Find("Damage Code", LookIn:=xlValues) 
         If Not c Is Nothing Then 
          firstAddress = c.Address 
          Do 

           Set dArea = c.Offset(0, 1) 
           Set dType = dArea.Offset(0, 1) 
           Set dSev = dType.Offset(0, 1) 
           ' It got really tricky trying to just use the c.offset thing since the columns are all merged - This works better. 

           damage = Left(dArea.Value, 2) 
           damage = damage & "." & Left(dType.Value, 2) 
           damage = damage & "." & dSev.Value & " " 


           If uInStr(result, damage) = -1 Then 
            ' If the damage is not found within the string already, include it, otherwise just continue through the loop 
            result = result & " " & damage 
           End If 

           Set c = .FindNext(c) 
           ' Get the next value 
          Loop While Not c Is Nothing And c.Address <> firstAddress 
         End If 
        End With 

        Set rng = .Range("A1", .Cells(lRow, lCol)) 

        With NewMail 

         subject = .subject 
         subject = Replace(subject, "00/00/00", ddate) 
         subject = Replace(subject, "VIN# ", "VIN# " & vin) 
         subject = Replace(subject, "Make Model", model) 
         subject = Replace(subject, "ORIGIN", UCase(origin) & " ORIGIN") 
         subject = Replace(subject, "TTGXxxxx", Railcar) 
         subject = Replace(subject, "CODE: ", "CODE: " & result) 
         subject = Replace(subject, "CODES: ", "CODES: " & result) 
         subject = Replace(subject, "BAY#", "BAY# " & bay) 
         subject = Replace(subject, " ", " ") 
         .subject = subject 
         .BodyFormat = olFormatHTML 
         .HTMLBody = RangetoHTML(rng) 
         .Display 

        End With 

       End With 


       eAttachment.Workbooks(.Item(i).FileName).Close 

       Exit For 

      End If 

     Next 
    End With 

End Sub 
Function RangetoHTML(rng As Range) 
' By Ron de Bruin. 
    Dim fso As Object 
    Dim ts As Object 
    Dim TempFile As String 
    Dim TempWB As workBook 

    Dim excelApp As Excel.Application 
    Set excelApp = New Excel.Application 

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 


    'Copy the range and create a new workbook to past the data in 
    rng.Copy 
    Set TempWB = Workbooks.Add(1) 
    With TempWB.Sheets(1) 
     .Cells(1).PasteSpecial Paste:=8  ' Paste over column widths from the file 
     .Cells(1).PasteSpecial xlPasteValues 
     .Cells(1).PasteSpecial xlPasteFormats 
     .Cells(1).Select 
     excelApp.CutCopyMode = False 
     On Error Resume Next 
     .DrawingObjects.Visible = True 
     .DrawingObjects.Delete 
     On Error GoTo 0 
    End With 

    'Publish the sheet to a htm file 
    With TempWB.PublishObjects.Add(_ 
     SourceType:=xlSourceRange, _ 
     FileName:=TempFile, _ 
     Sheet:=TempWB.Sheets(1).Name, _ 
     Source:=TempWB.Sheets(1).UsedRange.Address, _ 
     HtmlType:=xlHtmlStatic) 
     .Publish (True) 
    End With 

    'Read all data from the htm file into RangetoHTML 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) 
    RangetoHTML = ts.ReadAll 
    ts.Close 
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ 
          "align=left x:publishsource=") 

    'Close TempWB 
    TempWB.Close savechanges:=False 

    'Delete the htm file we used in this function 
    Kill TempFile 

    Set ts = Nothing 
    Set fso = Nothing 
    Set TempWB = Nothing 
End Function 
Function uInStr(haystack As String, needle As String) As Integer 
    Dim nStr As Integer 

    If haystack = "" Then 
     ' Kept getting an error because I was trying to use the Left function an a string with no length 
     uInStr = -1 
     Exit Function 
    End If 

    nStr = InStr(haystack, needle) 
    If haystack = needle Then 
     uInStr = 0 
     Exit Function 
    End If 
    If nStr > 0 Then 
     uInStr = nStr 
     Exit Function 
    Else 

     If Not Left(haystack, Len(needle)) = needle Then 
      uInStr = -1 
      Exit Function 
     Else 
      uInStr = 0 
      Exit Function 
     End If 

    End If 
End Function 

EDIT: Для того, чтобы заставить его работать, я просто должен был изменить каталог, в котором файл был сохранен в настоящее время почему-то мой босс компьютер не имеет доступа к пути окружающей среды. (что было странно само по себе). Итак, теперь код выглядит следующим образом:

sFileName = "C:/temp/" & .Item(i).FileName 
... Other Code here 
Kill "C:/temp/*.xls" 

Спасибо за помощь всем.

Answer 1

Я отредактировал это, и именно поэтому мы ясно, что закончилось тем, что компьютер моего босса не имел доступа к переменной окружения по какой-то странной причине. Код теперь читает:

sFileName = "C:/temp/" & .Item(i).FileName 
... Other Code here 
Kill "C:/temp/*.xls"