Vielen Dank im Voraus
thomas
Public
Sub Application_NewMail()
' Variablen deklarieren
Dim Laenge As Double
Dim Text1 As String
Dim objApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objMAPIFolder As Outlook.MAPIFolder
Dim objMailItem As Outlook.MailItem
Dim lngOldMailCounter As Long
Dim lngNewMailCounter As Long
Dim strBetreff As String
Dim strText As String
Dim strWebAdresse As String
Dim strWorkbook As String
Dim appExcel As Object
Dim sWorkbook As Object
Dim sPfad As String
Dim sFile As String
Dim sMacro As String
sPfad = "C:\aktuel"
sFile = "Trend1-24.xls"
strWorkbook = sPfad & "\" & sFile ' initialisiern
Set appExcel = CreateObject("Excel.Application")
'Set sWorkbook = appExcel.Workbooks(sFile)
Set objApp = New Outlook.Application
Set objNameSpace = objApp.GetNamespace(Type:="MAPI")
Set objMAPIFolder = objNameSpace.GetDefaultFolder(FolderType:=olFolderInbox)
'ExcelObject erstellen
' Posteingang lesen
For Each objMailItem In objMAPIFolder.Items
With objMailItem
If .UnRead = True Then
strBetreff = .Subject
strText = .Body
Laenge = Len(strText)
strText = Left(strText, Laenge - 4)
If strBetreff = "trade as hell" Then
If strText = "nichtmehrtraden" Then
appExcel.Workbooks.Open strWorkbook
With Sheets("accountinfo")
user = .Cells(3, 2).Value
login = .Cells(4, 2).Value
.Cells(3, 2).Value = 0
.Cells(4, 2).Value = 0
End With
Else
If strText = "wiedertraden" Then
appExcel.Workbooks.Open strWorkbook
With Sheets("accountinfo")
.Cells(3, 2).Value = user
.Cells(4, 2).Value = login
End With
Else
End If
End If
Else
End If
End If
End With
Next objMailItem
End Sub