Is there a VBA Expert who can help me!!!

[Solutionmatt]

Hey Guy's,

Firstly, I am not a wizard when it comes to VBA codes, I'm more a copy, paste a pray sort of guy! So if my question is Moronic, apologies in advance!

I have searched the web high and low for a VBA module that is executed by an ActiveX control button to send from a gmail account to;

• send flag field range of cells A2:I37 as a pdf to email address in A1.
• save the file as a pdf and as xlsm to 1 file location - filepath C:\Users\User\OneDrive\Documents\RECORDS

If anyone can help, or, has encountered this request before and can share the code I will be so grateful!

Thanks in advance

 

[Candyman8019]

I'm sure there's more than one way to accomplish this, but here's a script that I use in one of my workbooks to email receipts to people (this list is from line 6-107...can be changed to suit your sheet). Overall, you should be able to massage it to meet your needs. In my workbook I have a tab that details the smtp address, sendfrom address, password, print area, etc. all set up with named ranges rather than hardcoding those details into the script. NOTE: If you are using a gmail account to send from, you'll have to go into that account and change your security settings to allow "less secure" apps to send mail on your behalf. You'll also see that there is a built in delay. This is to allow each email to send rather than hanging up the system with too many emails going out too quickly.

Sub CDO_Receipt()
Application.DisplayAlerts = False
' Create PDF of active sheet and send as attachment.
'
Dim strPath As String, strFName As String
Dim LineNo As Integer
Dim EmailLine As Integer
Dim OutApp As Object, OutMail As Object
Dim ws As Worksheet
Dim wp As Worksheet
Dim wConfig As Worksheet
Set ws = ThisWorkbook.Sheets("BatchReceipts")
Set wp = ThisWorkbook.Sheets("Attendance")
Set wConfig = ThisWorkbook.Sheets("Config")
ws.PageSetup.PrintArea = ws.Range("Print_Area").Address
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String

strPath = "c:\windows\temp\" 'Or any other path, but include trailing "\"
wp.Range("Row_Index").Value = 6


'Insert Do While around this section?
Do
'Create PDF of active sheet only
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
= wConfig.Range("SMTP_Server").Text
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = wConfig.Range("Auth_Name").Text
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = wConfig.Range("Auth_Password").Text
.Update
End With

strbody = wConfig.Range("Body_Text").Text

'Create PDF of active sheet only

If wp.Cells(wp.Range("Row_Index").Value, 2).Text <> "" Then

strFName = "EventReceipt.pdf"

Dim Start As Single
Start = Timer
'wait x sec...
Do While Start + wConfig.Range("Cycle_Delay").Value > Timer
DoEvents
Loop

ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath & strFName, IgnorePrintAreas:=False, OpenAfterPublish:=False

With iMsg
Set .Configuration = iConf

' .To = ThisWorkbook.Sheets("Receipts").Range(B & LineNo).Value
.To = wp.Cells(wp.Range("Row_Index").Value, 2).Text
.CC = ""
.BCC = wConfig.Range("BCC_Addr").Text
.From = wConfig.Range("Auth_Name").Text
.Subject = wConfig.Range("Subject_Text").Text
.TextBody = strbody
.AddAttachment strPath & strFName
.Send
End With
End If
wp.Range("Row_Index").Value = wp.Range("Row_Index").Value + 1
Loop While wp.Range("Row_Index").Value < 107
Application.DisplayAlerts = True
MsgBox ("Batch Complete")
End Sub