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:
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
- Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
- Dim strTmpDir As String
- Dim strResult As String
- Dim x, nCheck, nImp, nAtt, nIndex As Integer
- Dim oMail As Outlook.MailItem
- Dim oInsp As Outlook.Inspector
- Dim oRecip As Outlook.Recipient
- Dim oAtt As Outlook.Attachment
- Set oMail = Outlook.Application.CreateItem(olMailItem)
- Set oInsp = oMail.GetInspector
- nAtt = item.Attachments.Count
- nIndex = 1
- With oMail
- .Subject = item.Subject
- .Body = item.Body
- If nAtt > 0 Then
- Do
- strTmpDir = Environ(nIndex)
- nIndex = nIndex + 1
- Loop Until Left(strTmpDir, 8) = "HOMEPATH"
- strTmpDir = "C:" + Replace(strTmpDir, "HOMEPATH=", "") + "\Mail"
- If Dir(strTmpDir, vbDirectory) = "" Then
- MkDir (strTmpDir)
- End If
- For Each oAtt In item.Attachments
- oAtt.SaveAsFile (strTmpDir)
- Next
- End If
- End With
- x = item.Recipients.Count
- nImp = item.Importance
- If x > 0 Then
- With oMail
- 'Setzen der Dringlichkeit für zweite Mail
- If nImp = 0 Then
- .Importance = olImportanceLow
- ElseIf nImp = 1 Then
- .Importance = olImportanceNormal
- ElseIf nImp = 2 Then
- .Importance = olImportanceHigh
- End If
- For x = item.Recipients.Count To 1 Step -1
- If InStr(item.Recipients(x).Address, "@") > 0 Then
- nCheck = item.Recipients(x).Type
- Set oRecip = .Recipients.Add(item.Recipients(x).Address)
- 'Prüfung, ob Status des Empfängers To, CC oder BCC ist
- If nCheck = 1 Then
- oRecip.Type = olTo
- ElseIf nCheck = 2 Then
- oRecip.Type = olCC
- ElseIf nCheck = 3 Then
- oRecip.Type = olBCC
- End If
- item.Recipients.Remove (x)
- End If
- Next
- End With
- If oMail.Recipients.Count > 0 Then
- Call SendNonExchange(oMail, oInsp)
- Else
- Set oMail = Nothing
- Set oInsp = Nothing
- End If
- ........