Results 1 to 6 of 6
  1. #1
    Join Date
    May 2005
    Posts
    125
    Provided Answers: 1

    Question Unanswered: VB Help/Guidance required on Auto Email via outlook

    Hi

    I need your help / guidance, as to why the code I am using is failing intermittently

    I am using MS Office 2003 for the Database and Outlook & Excel

    The problem is intermittent, and this is why I am getting a tad frustrated, here is the back ground the database goes through a few procedures to produce two excel files File A (Bitspart.csv) & File B (Bitsload.csv) which are created within the customers directory. The Email VB code looks within the customer directory, creates a new email & attaches the first file and issues, the code then creates a second email & attaches the second file and issues.

    Every so often the user encounters two issues

    1. the code fails to create the email and we receive the error msg “An unknown error occurred while trying to email ” , this is written into the code
    2. the code creates the first email and issues, and then does not action the second email at all, but if the user immediately re runs the email process, both emails are sent with no problems

    And this is where I need some help, please see code below



    Code:
    Private Sub EmailBits()
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Function to email the Bits file as described by the FileName and FileLocation passed to the function.
    'Returns true if successful, false otherwise.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error GoTo err_catcher
    
    Dim OutApp As Object, OutMail As Object
    
    Dim SendTo As String
    Dim Address1 As String
    Dim Address2 As String
    
    
    Address1 = "****@*****"
    Address2 = "****@*****"
    
        
               
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
        
            With OutMail
                .Importance = 2
                .ReadReceiptRequested = True
                .to = Address1 & ";" & Address2
                .Subject = GetAccNo() & "  Bits Part File To Load - Via Rev 7"
                .Attachments.Add Me.ExportFolder & "\BITSpart.csv"
                .Body = "Please save attached file, to your H:\tmp and overwrite any existing file    " & _
                vbNewLine & _
                "Log in to Rev and using the menu (BCBS)" & _
                vbNewLine & _
                "Select (Bits Data Maintenance menu)" & _
                vbNewLine & _
                "Select (Prd Xrf Imp H\tmp\Bitpart.csv) and follow on screen prompts" & _
                vbNewLine & vbNewLine & _
                "Thank you"
             
                .send  'Or use Send
            End With
            
            Set OutMail = OutApp.CreateItem(0)
            
            With OutMail
                .Importance = 2
                .ReadReceiptRequested = True
                .to = Address1 & ";" & Address2
                .Subject = GetAccNo() & " BitsLoad.csv"
                .Attachments.Add Me.ExportFolder & "\BitLoad.csv"
                .Body = "Please save attached file, to your C:\tmp and overwrite any existing file" & _
                vbNewLine & _
                "Log in to Rev and using the menu (BCBS)" & _
                vbNewLine & _
                "Select (Bits Data Maintenance menu)" & _
                vbNewLine & _
                "Select (Cust Ref Imp C\tmp\BitLoad.csv) and follow on screen prompts" & _
                vbNewLine & vbNewLine & _
                "Thank you"
    
    
             
                .send  'Or use Send
            End With
    
            
            EmailQA = True
        
    err_catcher:
    
    If Err.Number <> 0 Then
        MsgBox "An unknown error occurred while trying to email QA.", vbInformation, "Error"
        EmailQA = False
        Err.Number = 0
    End If
    
    End Sub
    Thank you
    Last edited by MarkWhyte; 02-16-12 at 08:41.

  2. #2
    Join Date
    Jun 2011
    Location
    Inside your mind
    Posts
    297
    Can you encase the code in [ CODE ] ... [ /CODE ] tags...

    Horrible to read like that.
    Looking for the perfect beer...

  3. #3
    Join Date
    May 2005
    Posts
    125
    Provided Answers: 1
    Code Tags Done Sry

  4. #4
    Join Date
    Jun 2011
    Location
    Inside your mind
    Posts
    297
    Dump this into a module:

    Code:
    Function splitEmails(emailAddresses As String) As Collection
    
    Dim tmpArray As Collection
    
    ' Add the To recipient(s) to the message.
    If (InStr(emailAddresses, ";") > 0) Then
    
       Set tmpArray = New Collection
       Dim modRec As String
       Dim tmpStr As String
       
       'Saves the original string to a variable for manipulation.
       modRec = emailAddresses
       
       'Lets the while loop start.
       tmpStr = "Filler String. :)"
       
       Do While (Len(modRec) > 0)
       
          'Finds the first address.
          If (InStr(modRec, ";") > 0) Then
             tmpStr = Left(modRec, (InStr(modRec, ";") - 1))
          Else
              tmpStr = modRec
          End If
          
          'Saves it to the array.
          tmpArray.Add (tmpStr)
          
          'Removes the added address from the string of addresses.
          modRec = Replace(modRec, tmpStr, "", , 1)
          
          'removes the ';', if one exists.
          If (InStr(modRec, ";") > 0) Then
             modRec = Replace(modRec, ";", "", , 1)
          End If
          
       Loop
       
       Set splitEmails = tmpArray
    
    Else
    
       Set tmpArray = New Collection
       
       tmpArray.Add (emailAddresses)
       
       Set splitEmails = tmpArray
    
    End If
    
    End Function
    
    
    Function SendMessage(ToRecipient As String, ccRecipient As String, Subject As String, Message As String, _
                         Importance As OlImportance, Optional AttachmentPath)
                         
       Dim objOutlook As Outlook.Application
       Dim objOutlookMsg As Outlook.MailItem
       Dim objOutlookRecip As Outlook.Recipient
       Dim objOutlookAttach As Outlook.Attachment
       Dim tmpArray As Collection
    
       ' Create the Outlook session.
       Set objOutlook = CreateObject("Outlook.Application")
    
       ' Create the message.
       Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    
       With objOutlookMsg
       
          '
          ' Add the To recipient(s) to the message.
          '
          If (InStr(ToRecipient, ";") > 0) Then
          
             Set tmpArray = splitEmails(ToRecipient)
                      
             'Adds the recipients to the email if there are more than one.
             For i = 1 To tmpArray.Count
                Set objOutlookRecip = .Recipients.Add(tmpArray(i))
                objOutlookRecip.Type = olTo
             Next i
          
          'Adds the recipients to the email.
          Else
             Set objOutlookRecip = .Recipients.Add(ToRecipient)
             objOutlookRecip.Type = olTo
          End If
    
    
          '
          ' Add the CC recipient(s) to the message.
          '
          If (InStr(ccRecipient, ";") > 0) Then
          
             Set tmpArray = splitEmails(ccRecipient)
                      
             'Adds the recipients to the email if there are more than one.
             For i = 1 To tmpArray.Count
                Set objOutlookRecip = .Recipients.Add(tmpArray(i))
                objOutlookRecip.Type = olTo
             Next i
             
          Else
             Set objOutlookRecip = .Recipients.Add(ccRecipient)
             objOutlookRecip.Type = olCC
          End If
    
          ' Set the Subject, Body, and Importance of the message.
          .Subject = Subject
          .Body = Message
          .Importance = Importance
    
          ' Add attachments to the message.
          If Not IsMissing(AttachmentPath) Then
             Set objOutlookAttach = .Attachments.Add(AttachmentPath)
          End If
    
          ' Resolve each Recipient's name.
          For Each objOutlookRecip In .Recipients
             objOutlookRecip.Resolve
             If Not objOutlookRecip.Resolve Then
             objOutlookMsg.Display
          End If
          Next
          .Send
    
       End With
       
       Set objOutlookMsg = Nothing
       Set objOutlook = Nothing
       
    End Function
    Knocked it up quickly for you.

    Use the SendMessage function to send the email.

    Multiple E-mail addresses can be used, as well as cc addresses.

    For example:

    Code:
    sendmessage "a@b.com;c@d.com", "w@x.com;y@z.com", "Test message", "This is a test message.", olImportanceHigh, "C:/tmp.txt"
    Will send an email immediately:
    To: a@b.com and c@d.com
    CC: w@x.com and y@z.com
    Subject: Test message
    Message:This is a test message.
    High Importance
    Attachment: tmp.txt

    Might have some bugs in it, but seems to work alright from my testing.

    Not the most glamorous, but I just wrote it quickly based on the MS example.



    PS: You'll need, Tools -> References... -> Microsoft Outlook 12.0 Object Library enabled.
    Last edited by kez1304; 02-16-12 at 11:44.
    Looking for the perfect beer...

  5. #5
    Join Date
    May 2005
    Posts
    125
    Provided Answers: 1
    Thank you Kez for your time, I will get back to you

  6. #6
    Join Date
    Jun 2011
    Location
    Inside your mind
    Posts
    297
    You're very welcome mate.
    Looking for the perfect beer...

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •