Add Excel File to Outlook from Access.

[totalnovice2]

Hi.

Please can you advise what is wrong with this code?

It works as far as the data from access is taken over to excel and then the save box will come up - the issue is that I want to to automatically save this as a file name, open up outlook, attach it to an e-mail and send it.

Please let me know if you are able to assist.

Many thanks.

Private Sub Command154_Click()

On Error Resume Next
 
    Dim appExcel As Excel.Application
    Dim wbook As Excel.Workbook
    Dim wsheet As Excel.Worksheet
    
    Set appExcel = New Excel.Application
    Set wbook = appExcel.Workbooks.Open("C:\Users\me\desktop\Auto\Access\New Access\Latest\Tmobile & Orange.xltm")
    Set wsheet = wbook.Worksheets("Permit Request Form")
    
    With wsheet
        .Range("F2").Value = Forms![Front Page]![Address #2]
        .Cells(3, 2).Value = Forms![Front Page]![Site 2 Owner]
        .Cells(3, 3).Value = Forms![Front Page]![Site 2 Name]
     .Cells(3, 4).Value = Forms![Front Page]![Postcode S2]
     .Cells(3, 5).Value = Forms![Front Page]![Text98]
     .Cells(3, 6).Value = Forms![Front Page]![Text139]
     .Cells(3, 25).Value = Forms![Front Page]![Combo79] & " " & Forms![Front Page]![Combo81]
     
     
     wbook.ActiveDocument.SaveAs2 FileName:="C:\Users\Public\" & Forms![Front Page]![txt1141] & " " & Forms![Front Page]![Combo79] & " " & "Orange Tmob" & ".xltm"
Call Mail_Radio_Outlook4("C:\Users\Public\" & Forms![Front Page]![txt1141] & " " & Forms![Front Page]![Combo79] & " " & "Orange Tmob" & ".xltm")

End With
End Sub

Function Mail_Radio_Outlook4(activedoc As String)
'Working in Office 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim acc_req As String
    
    
    
       Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
  
    strbody = "Hello.<br> <br> Please Find attached request for access. <br>"
              
   acc_req = "Orange / Tmob Access request" & "  " & [Forms]![Front Page]![Text98].Value & "  " & Forms![Front Page]![Site 2 Name].Value
           
      With OutMail
      On Error Resume Next
      
        .Display
        .To = [EMAIL="example@Example.com"]example@Example.com[/EMAIL]
        .CC = ""
        .Subject = acc_req
        .Attachments.Add (wbook)
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Display
       
        
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    
    MsgBox "Your E-mail has been generated. Please add your climbing certificates", vbInformation + vbOKOnly, "E-mail Sent"
    
     
        
        
    
      
    wbook.Close True
    Set wbook = Nothing
    
    Set appExcel = Nothing
 
End Function

 

[pr2-eugin]

This is just some random guesses.. The problem might be that you do not have sufficient permission to save the file, so it prompts you to save in a different location? Or the path you specified does not exists?

 

[totalnovice2]

Thanks for the reply.

Only just noticed it. I gave up in the end and my colleagues are just going to have to settle with pressing "save & send" themselves on the excel files.

It works perfectly for word though.

Thanks again for the suggestions,

 

[Ashfaque]

Hi,

I tried to used the Function "Mail_Radiutlook4" code (last part of this thread with reasonable changes) in to my access db to send an email attachment thru outlook.

Although I have already similar code to send email but that was attaching snapshot reports and with PLAIN TEXT format only.

But the funtion "Mail_Radiutlook4" I used because it provides HTML format thats something more better.

The problem I am facing is:

With some changes into the code, I could save my excel file on to desktop, it does attach into email with HTML format and finally after few pop ups of Y/N, it starts sending email. After few second I can see the email with attachment into Sent item box.

But it never received in Inbox.

Sub test_grouping()

...Other code lines......

Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
rst.Close
End If

Call Mail_Radiutlook4("C:\Users\Ashfaque\Desktop\ORDERS IN.xlS")

End Sub

Function Mail_Radiutlook4(activedoc As String)

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim acc_req As String

Dim strMail As String

Dim MyFile As String

MyFile = "C:\Users\Ashfaque\Desktop\ORDERS IN.XLS"

strMail = "ashfaque_online@yahoo.com"

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = "PLEASE FIND ATTACHED ORDERS IN THIS MONTH."

acc_req = "ORDERS IN THIS MONTH"


With OutMail
On Error Resume Next

.Display
.To = strMail
.CC = ""
.subject = acc_req
.Attachments.Add (MyFile)
.HTMLBody = strbody & "" & .HTMLBody
.Display

.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing


End Function

There is no compilation error in all my lengthy code but I can't receive email on declared email ID. Even I tried to send on email Id but nothing coming into respective account inbox.

Can any one help me please ?

Thanks,
Ashfaque

 

[pr2-eugin]

Ashfaque, take away the On Error Resume Next Statement, it will pop up with an error (if any exists)..

 

[Ashfaque]

Thanks pr2-eugin,

I tried keeping away On Error..... And also changed to 'break on unhandeld errors' as well attribute and then compiled. NO ERROR but no email received yet. However it show into my sent item box.

Thanks,
Ashfaque

 

[Ashfaque]

Hi,

Now another thing came on light...

After setting to break on unhandeld error, I compiled and executed. It is done and received the email.

But strange thing is when I changed the email id to my own outlook id and sending to myself in outlook account, it is not coming.

This might be because of : (Just a thought)

1. I am using Avira antivirus that might stop email because at the time of sending diff small pop ups are appearing expressing that ' another prog is trying to send email from you outlook..allow him / reject etc.."

2. I have (moving) auto signature set in to my each new email.

Is this may be the reason?

Please advise.

Thanks,
Ashfaque Hussain

 

[totalnovice2]

Thanks for your responses. I still haven't sorted it out

 

[totalnovice2]

Just an update in case anyone else has this issue. I managed to get it working by using the attached coding.

Thanks again.

Private Sub Command154_Click()

On Error Resume Next
 
    Dim appExcel As Excel.Application
    Dim wbook As Excel.Workbook
    Dim wsheet As Excel.Worksheet
    
    
    
    Set appExcel = New Excel.Application
    appExcel.Visible = False
    Set wbook = appExcel.Workbooks.Open("C:\Users\Public\TmobileOrange1.xls")
    Set wsheet = wbook.Worksheets("Permit Request Form")
    
    With wsheet
        .Range("F2").Value = Forms![Front Page]![Address #2]
        .Cells(3, 2).Value = Forms![Front Page]![Site 2 Owner]
        .Cells(3, 3).Value = Forms![Front Page]![Site 2 Name]
     .Cells(3, 4).Value = Forms![Front Page]![Postcode S2]
     .Cells(3, 5).Value = Forms![Front Page]![Text98]
     .Cells(3, 6).Value = Forms![Front Page]![Text139]
     .Cells(3, 27).Value = Forms![Front Page]![Combo79] & "," & Forms![Front Page]![Combo81] & "," & Forms![Front Page]![Combo83] & "," & Forms![Front Page]![Combo93]
     .Cells(3, 28).Value = Forms![Front Page]![txtTelNo] & " " & Forms![Front Page]![Txteng2mob] & " " & Forms![Front Page]![Txteng3mob] & " " & Forms![Front Page]![Txteng4mob]
     .Cells(3, 7).Value = Forms![Front Page]![Text98]
     .Cells(3, 8).Value = Forms![Front Page]![Text139]
     .Cells(3, 16).Value = Forms![Front Page]![Text156]
     
     wbook.SaveAs FileName:="C:\Users\Public\" & " " & Forms![Front Page]![Combo79] & " " & Forms![Front Page]![Site 2 Name] & " " & "Orange Tmob" & ".xls"
     
     
     Call Mail_Radio_Outlook6("C:\Users\Public\" & " " & Forms![Front Page]![Combo79] & " " & Forms![Front Page]![Site 2 Name] & " " & "Orange Tmob" & ".xls")
     
     wbook.Close
     
     appExcel.Close
               
     Set appExcel = Nothing
 
End With
End Sub