Rem Koden er udarbejdet i 2003-versionen - reference til OutLook er sat
Rem ===================================================================
Rem
www.contextmagic.com/express-clickyes/Rem ======================================
Rem På ovennævnte site kan der downloades kode, der undertrykker meddelelsen "Et program prøver at.."
Rem (Har anvendt det i flere år - uden problemer)
Rem =================================================================================================
Private Sub testMail()
Dim mailApp, Namespace, indbakke, m, sidsteLinie As String, række
On Error GoTo afslut
Rem Opsætter "forbindelse til indbakken"
Set mailApp = CreateObject("Outlook.Application")
Set Namespace = mailApp.GetNamespace("MAPI")
Set indbakke = Namespace.GetDefaultFolder(olFolderInbox)
Rem Traversere indbakken
If indbakke.Items.Count > 0 Then
For m = 1 To indbakke.Items.Count
emne = indbakke.Items(m).Subject
Rem Tester emne-teksten - eksempel "Eksempel på mail" med start i første pos.
If InStr(emne, "Eksempel på mail") = 1 Then
Rem Hvis ja - overfør meddelelsesteksten til variablen Tekst
tekst = indbakke.Items(m).Body
Rem fang antal tegn i meddelelsen
antaltegn = Len(tekst)
sidsteLinie = ""
Rem Traverser gennem Tekst med start i sidste tegn og opbyg sidste linie tegnvist
For t = antaltegn To 1 Step -1
tegn = Mid(tekst, t, 1)
sidsteLinie = tegn + sidsteLinie
Rem Test om linieskift / ny linie - hvis ja - afslut gennemløb
If InStr(sidsteLinie, Chr(13) & Chr(10)) = 1 Then
If Len(sidsteLinie) > 2 Then
Exit For
Else
If Len(sidsteLinie) = 2 Then
sidsteLinie = ""
End If
End If
End If
Next t
Rem Fjern linieskift / ny linie i pos.1
sidsteLinie = Mid(sidsteLinie, 3) + ";"
MsgBox (sidsteLinie) 'kontrol kan slettes eller elimineres...(Rem eller ')
Rem opsplit de enkelte elementer
elementer = Split(sidsteLinie, ";")
antalelementer = UBound(elementer)
Rem sæt dem i regnearket
række = 1 'temp. løsning....
For a = 0 To antalelementer - 1
Cells(række, 1 + a) = elementer(a)
Next a
End If
Columns.AutoFit
Next m
End If
MsgBox ("Gennemløb afsluttet")
afslut:
End Sub
