zwei Codes zusammenführen mit Loop
René
ich habe zwei Codes die ich zusammenfüreh möchte zu einem und bin da echt überfordert. Kann mir da jemand helfen?
Danke René
Anbei die zwei Codes
Private Sub Application_NewMailEx _
(ByVal EntryIDCollection As String)
Dim arr() As String
Dim i As Integer
Dim ns As Outlook.NameSpace
Dim itm As MailItem
Dim m As Outlook.MailItem
Dim MyBetreff As String
MyBetreff = "Epikrise"
On Error Resume Next
Set ns = Application.Session
arr = Split(EntryIDCollection, ",")
For i = 0 To UBound(arr)
Set itm = ns.GetItemFromID(arr(i))
If itm.Class = olMail Then
Set m = itm
Set myItem = Application.Session.GetDefaultFolder(olFolderSentItem).Items(1)
myItem.Display
strname = m.Subject
strname = m.Subject
If InStr(1, strname, MyBetreff) = 0 Then
myItem.Close olSave
myItem.UnRead = True
Exit Sub
ElseIf InStr(1, strname, MyBetreff) 0 Then
strname = Replace(strname, ":", " ")
strname = Replace(strname, "/", " ")
End If
Dim strPrompt As String
m.SaveAs "Y:\Patientendaten1\" & strname & " " & "Datum" & "_" & Day(Date) & "_" & _
Month(Date) & "_" & Year(Date) & "_" & "Uhrzeit" & "_" & Hour(Time) & "_" & Minute(Time) & ". _
msg", olMSG
myItem.Close olSave
myItem.UnRead = True
End If
Next
Set ns = Nothing
Set itm = Nothing
Set m = Nothing
End Sub
Private Sub Application_NewMailEx _
(ByVal EntryIDCollection As String)
Dim arr() As String
Dim i As Integer
Dim ns As Outlook.NameSpace
Dim itm As MailItem
Dim m As Outlook.MailItem
Dim MyBetreff As String
MyBetreff = "Epikriseergebnis"
On Error Resume Next
Set ns = Application.Session
arr = Split(EntryIDCollection, ",")
For i = 0 To UBound(arr)
Set itm = ns.GetItemFromID(arr(i))
If itm.Class = olMail Then
Set m = itm
Set myItem = Application.Session.GetDefaultFolder(olFolderInbox).Items(1)
myItem.Display
strname = m.Subject
strname = m.Subject
If InStr(1, strname, MyBetreff) = 0 Then
myItem.Close olSave
myItem.UnRead = True
Exit Sub
ElseIf InStr(1, strname, MyBetreff) 0 Then
strname = Replace(strname, ":", " ")
strname = Replace(strname, "/", " ")
End If
Dim strPrompt As String
m.SaveAs "Y:\Patientendaten2\" & strname & " " & "Datum" & "_" & Day(Date) & "_" & _
Month(Date) & "_" & Year(Date) & "_" & "Uhrzeit" & "_" & Hour(Time) & "_" & Minute(Time) & ". _
msg", olMSG
myItem.Close olSave
myItem.UnRead = True
End If
Next
Set ns = Nothing
Set itm = Nothing
Set m = Nothing
End Sub