LOOP and send e mail

[sal21]

I need to loop in my default inbox (posta in arrivo) all email, and send only not read item to :gss.xxx@xx.it.
naturally mark as read the item to not repaet the send.
How to?

IN VB 6.0, please

[HansV]

If you set a reference to the Outlook n.0 Object Library:

Code: Select all

Sub SendMail()
    Dim app As Outlook.Application
    Dim fld As Outlook.Folder
    Dim itm As Outlook.MailItem
    Dim f As Boolean
    On Error Resume Next
    Set app = GetObject(Class:="Outlook.Application")
    If app Is Nothing Then
        Set app = CreateObject(Class:="Outlook.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    app.Session.Logon
    Set fld = app.Session.GetDefaultFolder(olFolderInbox)
    For Each itm In fld.Items
        If itm.UnRead Then
            With itm.Forward
                .To = "gss.xxx@xx.it"
                .Send
            End With
            itm.UnRead = False
        End If
    Next itm
ExitHandler:
    On Error Resume Next
    If f Then
        app.Quit
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

If you don't set a reference:

Code: Select all

Sub SendMail()
    Dim app As Object
    Dim fld As Object
    Dim itm As Object
    Dim f As Boolean
    On Error Resume Next
    Set app = GetObject(Class:="Outlook.Application")
    If app Is Nothing Then
        Set app = CreateObject(Class:="Outlook.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    app.Session.Logon
    Set fld = app.Session.GetDefaultFolder(6)
    For Each itm In fld.Items
        If itm.UnRead Then
            With itm.Forward
                .To = "gss.xxx@xx.it"
                .Send
            End With
            itm.UnRead = False
        End If
    Next itm
ExitHandler:
    On Error Resume Next
    If f Then
        app.Quit
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Remark: the code works best if Outlook is already running on your computer.

[sal21]

If you set a reference to the Outlook n.0 Object Library:

Code: Select all

Sub SendMail()
    Dim app As Outlook.Application
    Dim fld As Outlook.Folder
    Dim itm As Outlook.MailItem
    Dim f As Boolean
    On Error Resume Next
    Set app = GetObject(Class:="Outlook.Application")
    If app Is Nothing Then
        Set app = CreateObject(Class:="Outlook.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    app.Session.Logon
    Set fld = app.Session.GetDefaultFolder(olFolderInbox)
    For Each itm In fld.Items
        If itm.UnRead Then
            With itm.Forward
                .To = "gss.xxx@xx.it"
                .Send
            End With
            itm.UnRead = False
        End If
    Next itm
ExitHandler:
    On Error Resume Next
    If f Then
        app.Quit
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

If you don't set a reference:

Code: Select all

Sub SendMail()
    Dim app As Object
    Dim fld As Object
    Dim itm As Object
    Dim f As Boolean
    On Error Resume Next
    Set app = GetObject(Class:="Outlook.Application")
    If app Is Nothing Then
        Set app = CreateObject(Class:="Outlook.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    app.Session.Logon
    Set fld = app.Session.GetDefaultFolder(6)
    For Each itm In fld.Items
        If itm.UnRead Then
            With itm.Forward
                .To = "gss.xxx@xx.it"
                .Send
            End With
            itm.UnRead = False
        End If
    Next itm
ExitHandler:
    On Error Resume Next
    If f Then
        app.Quit
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Remark: the code works best if Outlook is already running on your computer.

tks for code!
You understand me on fly... two solution for me are the best, you know me:-)