Outlook: VBA - Anhang lässt sich nicht in Filesystem schreiben

  • Sonstige

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von rockotron.

    Outlook: VBA - Anhang lässt sich nicht in Filesystem schreiben

    Hallo,

    ich habe folgendes Problem. Ich erzeuge per VBA eine Kopie der originalen zu versendenden Mail, welche nun natürlich auch die Anhänge des Originals erhalten soll. Diese müssen, soweit ich weiß, zwischengespeichert werden, bevor sie in das neue Mail-Objekt übernommen werden können. Unter Windows 7 (Outlook 2003) habe ich nun das Problem, dass ich grundsätzlich keine Schreibberechtigungen auf den neu erzeugten Ordner erhalte (Homepath\Mail)(siehe Zeile 32). Hat jemand eine Idee, wie ich das umgehen kann?

    Mein Code:

    Visual Basic-Quellcode

    1. Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
    2. Dim strTmpDir As String
    3. Dim strResult As String
    4. Dim x, nCheck, nImp, nAtt, nIndex As Integer
    5. Dim oMail As Outlook.MailItem
    6. Dim oInsp As Outlook.Inspector
    7. Dim oRecip As Outlook.Recipient
    8. Dim oAtt As Outlook.Attachment
    10. Set oMail = Outlook.Application.CreateItem(olMailItem)
    11. Set oInsp = oMail.GetInspector
    12. nAtt = item.Attachments.Count
    13. nIndex = 1
    15. With oMail
    16. .Subject = item.Subject
    17. .Body = item.Body
    19. If nAtt > 0 Then
    20. Do
    21. strTmpDir = Environ(nIndex)
    22. nIndex = nIndex + 1
    23. Loop Until Left(strTmpDir, 8) = "HOMEPATH"
    25. strTmpDir = "C:" + Replace(strTmpDir, "HOMEPATH=", "") + "\Mail"
    27. If Dir(strTmpDir, vbDirectory) = "" Then
    28. MkDir (strTmpDir)
    29. End If
    31. For Each oAtt In item.Attachments
    32. oAtt.SaveAsFile (strTmpDir)
    33. Next
    34. End If
    35. End With
    37. x = item.Recipients.Count
    38. nImp = item.Importance
    40. If x > 0 Then
    41. With oMail
    42. 'Setzen der Dringlichkeit für zweite Mail
    43. If nImp = 0 Then
    44. .Importance = olImportanceLow
    45. ElseIf nImp = 1 Then
    46. .Importance = olImportanceNormal
    47. ElseIf nImp = 2 Then
    48. .Importance = olImportanceHigh
    49. End If
    51. For x = item.Recipients.Count To 1 Step -1
    52. If InStr(item.Recipients(x).Address, "@") > 0 Then
    53. nCheck = item.Recipients(x).Type
    54. Set oRecip = .Recipients.Add(item.Recipients(x).Address)
    56. 'Prüfung, ob Status des Empfängers To, CC oder BCC ist
    57. If nCheck = 1 Then
    58. oRecip.Type = olTo
    59. ElseIf nCheck = 2 Then
    60. oRecip.Type = olCC
    61. ElseIf nCheck = 3 Then
    62. oRecip.Type = olBCC
    63. End If
    65. item.Recipients.Remove (x)
    66. End If
    67. Next
    68. End With
    70. If oMail.Recipients.Count > 0 Then
    71. Call SendNonExchange(oMail, oInsp)
    72. Else
    73. Set oMail = Nothing
    74. Set oInsp = Nothing
    75. End If
    76. ........

Facebook
Telefonspende