-
how to append data from outlook into excel
case:
I get mails dispatched
this mail has as subject : FW blablabla
in this mail I have in the body the text
mailnummer: 935
I am able to retrieve the subject and mailnummer however I am not able to append this to an excisting excel sheet where already data is present
how do I do this?
at this point it gives me a msgbox with the info cause I don't know how to add this info into an excisting excel sheet with the condition that he has to enter the data on the first empty row that's available
thanks in advance for your help
[VBA]
Sub SaveMessages()
'Declaration
Dim myItems, myItem As Object
Dim myOrt As String
Dim strdate As String
Dim newdate As String
Dim strname As String
Dim newstr As String
Dim i As Integer
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim FindTerm(13)
'Set invalid characters to replace
FindTerm(0) = "*"
FindTerm(1) = "@"
FindTerm(2) = "\"
FindTerm(3) = "("
FindTerm(4) = ")"
FindTerm(5) = "["
FindTerm(6) = "]"
FindTerm(7) = "?"
FindTerm(8) = "<"
FindTerm(9) = ">"
FindTerm(10) = "!"
FindTerm(11) = "{"
FindTerm(12) = "}"
FindTerm(13) = ":"
'Ask for destination folder
myOrt = ("C:\TEMP\")
On Error Resume Next
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'for all items do...
For Each myItem In myOlSel
strdate = myItem.SentOn
newdate = Format(strdate, "yyyymmddhhmm")
strname = newdate & "-" & myItem.Subject & ".msg"
For i = 1 To 13
newstr = Replace(strname, FindTerm(i), " ")
strname = newstr
Next
'myItem.SaveAs myOrt & newstr
MsgBox GetMailID(myItem.HTMLBody) & " - " & myItem.Subject
'myItem.Delete
Next
'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
Private Function GetMailID(sBody As String) As String
Dim aTmp() As String
Dim i As Integer
aTmp = Split(sBody, vbCrLf)
For i = 0 To UBound(aTmp)
If InStr(1, aTmp(i), "mail", vbTextCompare) > 0 Then
GetMailID = Right(aTmp(i), Len(aTmp(i)) - InStr(1, aTmp(i), "mail", vbTextCompare) + 1) 'Mid(aTmp(i), InStr(1, aTmp(i), "mail", vbTextCompare), InStr(1, aTmp(i), "mail", vbTextCompare) - InStr(InStr(1, aTmp(i), "mail", vbTextCompare), aTmp(i), "<"))
GetMailID = Left(GetMailID, InStr(1, GetMailID, "<", vbTextCompare) - 1)
Exit For
End If
Next i
End Function
[/VBA]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules