所以，这是我迄今为止在VBA中遇到的最奇怪的问题之一。
我参与了一个执行以下操作的宏：
所以，我已经把所有这些都用在了我开发的计算机上。工作正常，没有问题。我的老板试图将它添加到他的电脑中，但它不起作用。它给出了这个错误
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
编辑：为了让它工作，我只需要更改保存文件的目录。出于某种原因，我老板的电脑无法访问环境路径（这本身很奇怪）。所以现在代码为：
sFileName = "C:/temp/" & .Item(i).FileName
... Other Code here
Kill "C:/temp/*.xls"
感谢大家的帮助。