Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Daten aus Mails nach Excel exportieren
#21
Kann ich nicht nachvollziehen. Da müsste ich reinschauen können (heute nicht mehr, muss zur Spätschicht).
Antworten Top
#22
Hallo mumpel,
mach erstmal Deine Schicht. Reinschauen kannst Du ggf. über TeamViewer.

Gruß Kreck2
Antworten Top
#23
Problem gelöst (per Fernkonferenz).
Antworten Top
#24
Hier noch der Code, für alle die es interessiert.

Option Explicit

Public Sub UebertragAntragTest()

Dim olApp           As Outlook.Application
Dim olName          As Outlook.NameSpace
Dim olFolderStart   As Outlook.MAPIFolder
Dim olFolderEnd     As Outlook.MAPIFolder

Dim xlApp           As Excel.Application
Dim xlBook          As Excel.Workbook
Dim xlSheet         As Excel.Worksheet

Dim olFolderItems   As Long

Dim strNewSubject   As String
Dim vntTempArray    As Variant
Dim lngTextToVal    As Long
Dim lngZeileFzArt   As Long

Dim xlRange         As Long
Dim lngFZCount      As Long



Set olApp = Application
Set olName = olApp.GetNamespace("MAPI")
Set olFolderStart = olName.Session.Folders("RMH Software").Folders("Posteingang").Folders("Ticket-System")
Set olFolderEnd = olName.Session.Folders("RMH Software").Folders("Posteingang").Folders("Ticket-System").Folders("Erledigt")
    
    
Set xlApp = New Excel.Application
    With xlApp
        .Visible = True
        .Workbooks.Open Environ("USERPROFILE") & "\Desktop\Moped2015.xlsb"
         Set xlBook = xlApp.Workbooks("Moped2015.xlsb")
         Set xlSheet = xlBook.Sheets("Import Jürgen")
             With xlBook
                  With xlSheet
                       For olFolderItems = olFolderStart.Items.Count To 1 Step -1
                           strNewSubject = Replace(olFolderStart.Items(olFolderItems).Subject, _
                                                   "[ACHTUNG! Absenderadresse kann gefaelscht sein - bitte ueberpruefen!] ", "")
                           strNewSubject = Replace(strNewSubject, "(", "")
                           strNewSubject = Replace(strNewSubject, ")", "")
                           If Mid(strNewSubject, 1, 9) = "Ticket_ID" Then
                              vntTempArray = Split(olFolderStart.Items(olFolderItems).Body, vbCrLf)
                              lngTextToVal = Val(Mid(vntTempArray(40), 9, 1))
                              lngZeileFzArt = 15
                              For lngFZCount = 1 To lngTextToVal
                                  xlRange = _
                                   .Range("A" & .Rows.Count).End(xlUp).Row + 1
                                   .Range("A" & xlRange) = olFolderStart.Items(olFolderItems).SentOn
                                   .Range("B" & xlRange) = strNewSubject
                                   .Range("D" & xlRange) = lngTextToVal
                                   .Range("E" & xlRange) = Replace(vntTempArray(5), "Anrede:           ", "")
                                   .Range("F" & xlRange) = Replace(vntTempArray(6), "Name:             ", "")
                                   .Range("G" & xlRange) = Replace(vntTempArray(7), "Vorname:          ", "")
                                   .Range("H" & xlRange) = Replace(vntTempArray(8), "Geburtstag:       ", "")
                                   .Range("I" & xlRange) = Replace(vntTempArray(9), "Strasse:          ", "")
                                   .Range("J" & xlRange) = Replace(vntTempArray(10), "Plz:              ", "")
                                   .Range("K" & xlRange) = Replace(vntTempArray(11), "Ort:              ", "")
                                   .Range("L" & xlRange) = Replace(vntTempArray(12), "Mail_wiederholt: ", "")
                                   .Range("M" & xlRange) = Replace(vntTempArray(13), "alter1:           ", "")
                                   .Range("N" & xlRange) = Replace(vntTempArray(14), "Telefon:          ", "")
                                   .Range("O" & xlRange) = Replace(vntTempArray(lngZeileFzArt), "fahrzeug_art" & lngFZCount & ":    ", "")
                                   .Range("P" & xlRange) = Replace(vntTempArray(lngZeileFzArt + 1), "fahrzeug_hersteller" & lngFZCount & ": ", "")
                                   .Range("Q" & xlRange) = Replace(vntTempArray(lngZeileFzArt + 2), "fahrzeug_schlüssel" & lngFZCount & ": ", "")
                                   .Range("R" & xlRange) = Replace(vntTempArray(lngZeileFzArt + 3), "fahrzeug_datum" & lngFZCount & ":  ", "")
                                   .Range("S" & xlRange) = Replace(vntTempArray(lngZeileFzArt + 4), "vorvertrag" & lngFZCount & ":      ", "")
                                   .Range("U" & xlRange) = Replace(vntTempArray(35), "angebot:          ", "")
                                   .Range("V" & xlRange) = Replace(vntTempArray(36), "beratung:         ", "")
                                   .Range("W" & xlRange) = Replace(vntTempArray(37), "zustimmung:       ", "")
                                   .Range("T" & xlRange) = Mid(vntTempArray(44), 14, 4)
                                    lngZeileFzArt = lngZeileFzArt + 5
                              Next lngFZCount
                           End If
                           olFolderStart.Items(olFolderItems).Move olFolderEnd
                       Next olFolderItems
                  End With
                 .Save
                 .Close
             End With
            .Quit
    End With
End Sub


VBA/HTML - CodeConverter für Office-Foren, AddIn für Office 2002-2013 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:mumpel

Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

[-] Folgende(r) 1 Nutzer sagt Danke an mumpel für diesen Beitrag:
  • Kreck2
Antworten Top
#25
Mumpel ist genial!
Danke!
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste