Loop some butchered code.

[Homegrownandy]

As the title suggests. I've managed to get something working in VBA. Now don't all congratulate me at once. There's still some way to go.

Private Sub Command25_Click()

    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Dim strPath As String
    Dim strFile As String
    strPath = "\\server\finance\invoices\" & Me.Company_Name & "" & Me.Order_Number & ""
    strFile = Me.Order_Number & "-" & Me.Order_ID & "-" & Me.On_Issue & ".pdf"
    
    Debug.Print strPath
    Debug.Print strFile
    
    If strFile <> "" Then
        Set appOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = appOutLook.CreateItem(olMailItem)
        With MailOutLook
            .BodyFormat = olFormatRichText
            .To = "bob@builder.com"
            ''.cc = ""
            ''.bcc = ""
            .Subject = "text here"
            .HTMLBody = "text here"
            .Attachments.Add (strPath & strFile)
            '.Send
            .Display    'Used during testing without sending (Comment out .Send if using this line)
        End With
    Else
        MsgBox "No file matching " & strPath & " found." & vbCrLf & _
                "Processing terminated."
        Exit Sub    'This line only required if more code past End If
    End If
 

End Sub

I would like this to look through every record on the associated form. I'm asking here before I attempt it because I'm yet to be successful with loops.

If someone can help me get this working, I can then manipulate the data on the form for whatever reason (be it a different company or procedure, whatever). I want all of the attachments in the list to be on the same email. I don't know if this will be an issue or not.

Just as a note: The invoices and the file path are generated via the database. So we can assume they are all correct and working as its using the same data to make the file/path and in this to send that file.

as always, help appreciated.

[Homegrownandy]

If anyone is willing to get this to a working stage. This link may be helpful http://stackoverflow.com/questions/1...e-attachements

Ill pick up from here tomorrow. Thanks.

[orange]

Andy,

I don't use Outlook but I recall there are examples at BlueClaw. May not be exactly what you want, but should be helpful.
I know I have some old code for sending attachments. I'll do some searching and if found I will post same.

[davegri]

Here's something you may be able to adapt for your use. It generates an email for each person in tblWorkEmail and supports attachments.

Sub subOutlookEmailOption_6()
   Const olMailItem As Long = 0
   if MsgBox("This option uses Microsoft Outlook to email members " _
        & "with a personalized message." , 49, "  S E N D   B U L K   E M A I L  ") = vbcancel then
        exit sub
    end if
    Dim intCtr as Long
    Dim strTo As String
    Dim strbody As String
    Dim strFirst As String
    Dim strNLMO As String
    Dim strSender As String
    Dim strAttach As String
    Dim strSubject As String
    Dim I as Long
    Dim rst as DAO.Recordset 
    Set rst = CurrentDb.OpenRecordset("tblWorkEmail", dbOpenSnapshot)
    With rst
        If .RecordCount > 0 Then
            .MoveLast
            .MoveFirst
        End If
    End With


    strAttach = fcnBrowse("File")    'fcnBrowse calls file dialog and returns the path/filename
    If Len(strAttach & vbNullString) = 0 Then
        strAttach = "NONE"
    Else
        intMsgBox = MsgBox("The attachment will be:" & vbCrLf & strAttach & Space(5), _
        vbOKCancel, "E m a i l  A t t a c h m e n t")
        If intMsgBox = vbCancel Then Exit Sub
    End If
    
    'strbody = DLookup("emBodyText", "tblEmailOptions", "emOptionNo = " & arg)
    'strSender = DLookup("emSender", "tblEmailOptions", "emOptionNo = " & arg)
    For I = 1 To rst.RecordCount
        strSubject = "Your " & rst!NLMO & " Newsletter"
        strTo = rst!ME_MAIL1
        strNLMO = rst!NLMO
        strFirst = rst!First
        Dim olApp As Object
        Dim newMail As Object
        Dim olAttachment As Object
        Set olApp = CreateObject("Outlook.application")
        Set newMail = olApp.CreateItem(olMailItem)
        Set olAttachment = newMail.Attachments
        If Not IsNull(strAttach) Then
            If strAttach <> "NONE" Then
                olAttachment.Add strAttach
            End If
        End If
        Set newMail.sendusingaccount = olApp.session.accounts.Item(fcnGetSetupUserData(2))
        With newMail
            .To = strTo
            .subject = strSubject
            .body = "Dear " & strFirst & "," & vbCrLf & vbCrLf & strbody
            If I = 1 Then
                MsgBox "Make sure Outlook is running before proceeding..."
                .Display : intCtr = intCtr + 1
            Else
                .Send : intCtr = intCtr + 1
            End If
            'Debug.Print I & ". " & strTo & " with " & strAttach
        End With
        Set newMail = Nothing
        rst.MoveNext
    Next I
    MsgBox "Finished sending mail to Outlook." & vbCrLf _
    & intCtr & " emails sent", vbOKOnly, "   C O M P L E T E D   "
end sub

[ssanfu]

Maybe try this???

** untested **

Option Compare Database
Option Explicit

Private Sub Command25_Click()
    Dim rst As DAO.Recordset

    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Dim strPath As String
    Dim strFile As String

    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)

    Set rst = Me.RecordsetClone
    rst.MoveLast
    rst.MoveFirst

    Do Until rst.EOF
        strPath = "\\server\finance\invoices\" & rst!Company_Name & "" & rst!Order_Number
        '        strPath = "\\server\finance\invoices\" & Me.Company_Name & "" & Me.Order_Number
        strFile = Me.Order_Number & "-" & rst!Order_ID & "-" & rst!On_Issue & ".pdf"
        '        Debug.Print strPath
        '        Debug.Print strFile

        If strFile <> "" Then
            With MailOutLook
                .BodyFormat = olFormatRichText
                .To = "bob@builder.com"    '<<-- all emails go to same email address???
                ''.cc = ""
                ''.bcc = ""
                .Subject = "text here"
                .HTMLBody = "text here"
                .Attachments.Add (strPath & strFile)
                '.Send
                .Display    'Used during testing without sending (Comment out .Send if using this line)
            End With
        End If
        rst.MoveNext
    Loop

    'close recordset and clean up
    rst.Close
    Set rst = Nothing
    Set appOutLook = Nothing
    Set MailOutLook = Nothing

    MsgBox "Done"

End Sub

[Homegrownandy]

Hello, Ill have a go testing these, see how far I get. I did say that all attachments should be in the same email. having the same email address wont do this normally, it creates a new item, (not sure with this code yet) but I believe if the code to create the outlook "window" is outside the loop it should work.

Even if they are all sent individually to the same email it shouldn't be a problem really. Thanks for the replies.

Edit: steve just realised your comment was a question.

Emails will all be sent to the same address per company. I can put that in no problem.

[Homegrownandy]

Took a bit of playing with. But this is brilliant. I don't believe I've come across recordset clone before and this is a good/easy to read example of it. Really appreciate your help.

orange and dave, thanks for the input too.