Dear all,

I would like to be able to also open and Attach PDF's in teh following Macro
I have written. CAn you help.

Sub GetEmailData()
Dim Msg As String
Msg = "Send Emails? " & vbCrLf & vbCrLf _
& "Please make sure that all source files are closed"
If MsgBox(Msg, vbQuestion + vbYesNo, "SEND EMAILS") = vbNo Then
Exit Sub
End If

'COPY MAIL ONLY OPTIONS
Range("M19:M30").Select
Selection.Copy
Range("I19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Dim SourceFile As String, SourceRoot As String, SourceRef As String,
SourceFileNameOnly As String
Dim I As Integer, SendMailCol As Integer, PriorityCol As Integer, _
ZipCol As Integer, RecptCol As Integer, RefCol As Integer

Dim Row As Integer, Col As Integer, SubCol As Integer, FileNameCol As
Integer
Dim ControlFile, FileOnlyName As String, FileRoot As String, SubFolder
As String
Dim SendMail As String, Priority As String, Zip As String
Dim Recpt As String, Ref As Integer, LoopCounter As Integer

Row = 19
Col = 5
FileNameCol = 6
SubCol = 3
SendMailCol = 7
PriorityCol = 8
ZipCol = 9
RecptCol = 10
RefCol = 11
I = 0

Sheets("Send Mail").Select

FileRoot = Range("C11")
Cells(Row, Col).Select
SourceFile = Cells(Row, Col)
FileOnlyName = Cells(Row, FileNameCol)
SubFolder = Cells(Row, SubCol)
MainRegion = Cells(Row, 1)
SendMail = Cells(Row, SendMailCol)
Priority = Cells(Row, PriorityCol)
Zip = Cells(Row, ZipCol)
Recpt = Cells(Row, RecptCol)
Ref = Cells(Row, RefCol)
SourceFileNameOnly = Cells(Row, 4)

'LOOP THROUGH FILES
Do While SourceFile < "end of list"
Cells(Row, Col).Select
Application.ScreenUpdating = False

If UCase(SendMail) = "Y" Then
LoopCounter = Ref
ReDim AddArray(20, 7) As String
If Ref < 0 Then
Do While LoopCounter = Ref
'ZIP FILE AND ASSIGN TO ARRAY

If UCase(Zip) = "Y" Then
I = I + 1
AddArray(I, 1) = FileOnlyName
AddArray(I, 2) = Priority
AddArray(I, 3) = Recpt
AddArray(I, 4) = Ref
AddArray(I, 5) = SubFolder
AddArray(I, 6) = SourceFile
AddArray(I, 7) = SourceFileNameOnly
Else
If UCase(Cells(Row, 12)) = "Y" Then
I = I + 1
AddArray(I, 1) = "MAIL ONLY"
AddArray(I, 2) = Priority
AddArray(I, 3) = Recpt
AddArray(I, 4) = Ref
AddArray(I, 5) = ""
AddArray(I, 6) = ""
AddArray(I, 7) = ""
End If
End If

Application.ScreenUpdating = True
Row = Row + 1
Cells(Row, Col).Select
SourceFile = Cells(Row, Col)
FileOnlyName = Cells(Row, FileNameCol)
SubFolder = Cells(Row, SubCol)
MainRegion = Cells(Row, 1)
SendMail = Cells(Row, SendMailCol)
Priority = Cells(Row, PriorityCol)
Zip = Cells(Row, ZipCol)
Recpt = Cells(Row, RecptCol)
Ref = Cells(Row, RefCol)
SourceFileNameOnly = Cells(Row, 4)

Loop

End If

'CALL SEND MAIL
Call Send_Mail(AddArray)

End If

'NEXT FILE
Application.ScreenUpdating = True
Row = Row + 1
Cells(Row, Col).Select
SourceFile = Cells(Row, Col)
FileOnlyName = Cells(Row, FileNameCol)
SubFolder = Cells(Row, SubCol)
MainRegion = Cells(Row, 1)
SendMail = Cells(Row, SendMailCol)
Priority = Cells(Row, PriorityCol)
Zip = Cells(Row, ZipCol)
Recpt = Cells(Row, RecptCol)
Ref = Cells(Row, RefCol)
SourceFileNameOnly = Cells(Row, 4)
I = 0
Loop

Application.ScreenUpdating = True
Range("A1").Select

MsgBox "Process Complete", vbInformation, "SEND MAIL"

End Sub

Sub Send_Mail(AddArray)
'Microsoft Outlook nn Object Library should be included in
Tools/References
Dim OutApp As Object
Dim OutMail As Object
Dim mSubject As String, mBody As String, mDate As String, mSubFolder As
String, _
mPriority As String, mRecpt As String, mRoot As String, mFileName As
String, _
mFullPath As String, mSourceFile As String, mTo As String, mCC As
String, mBCC As String, _
mSourceFileNameOnly As String

Dim I As Integer, mRef As Integer

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

mPriority = AddArray(1, 2)
mRecpt = AddArray(1, 3)
mRef = AddArray(1, 4)
mSubFolder = AddArray(1, 5)
mRoot = Worksheets("Send mail").Range("C11")
I = 1

mTo = Worksheets("Mail Details").Cells(3, mRef)
mCC = Worksheets("Mail Details").Cells(5, mRef)
mBCC = Worksheets("Mail Details").Cells(7, mRef)
mSubject = Worksheets("Mail Details").Cells(9, mRef)
mBody = Worksheets("Mail Details").Cells(11, mRef)

Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = mTo
.cc = mCC
.Bcc = mBCC
.Subject = mSubject
.Body = mBody

If UCase(mRecpt) = "Y" Then
.ReadReceiptRequested = True
Else
.ReadReceiptRequested = False
End If


Select Case UCase(mPriority)
Case "H"
.Importance = olImportanceHigh
Case "L"
.Importance = olImportanceLow
Case Else
.Importance = olImportanceNormal
End Select

Do While AddArray(I, 1) < ""
mFileName = AddArray(I, 1)
mFullPath = mRoot & mSubFolder

If AddArray(I, 1) = "MAIL ONLY" Then

Else
'ZIP FILE
mSourceFile = AddArray(I, 6)
mSourceFileNameOnly = AddArray(I, 7)
Call ZipIt(mFullPath, mSourceFile, mFileName,
mSourceFileNameOnly)

'ATTACH FILE
mDate = Format(Now, "_dd_mm_yyyy")
mFullPath = mRoot & mSubFolder & Left(mFileName,
Len(mFileName) - 4) & mDate & ".zip"
.Attachments.Add mFullPath

'DELETE ZIP FILE
Call DeleteZip(mFullPath)
End If

I = I + 1
Loop

If Worksheets("Send Mail").Range("E6") = 2 Then
.Send
Else
.Display
End If

End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Sub NewZip(sPath)
'Create empty Zip File
If Len(Dir(sPath)) 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub

Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function Split97(sStr As Variant, sdelim As String) As Variant
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function

Sub ZipIt(mFullPath As String, mSourceFile As String, mFileName As String, _
mSourceFileNameOnly As String)

Workbooks.Open Filename:=mSourceFile, UpdateLinks:=3

Dim strDate As String, DefPath As String
Dim FileNameZip, FileNamexls
Dim oApp As Object
Dim FileExtStr As String

DefPath = mFullPath
If Right(DefPath, 1) < "\" Then
DefPath = DefPath & "\"
End If

' 'Create date/time string and the temporary xl* and Zip file name
If Val(Application.Version) < 12 Then
FileExtStr = ".xls"
'Else
' Select Case ActiveWorkbook.FileFormat
' Case 51: FileExtStr = ".xlsx"
' Case 52: FileExtStr = ".xlsm"
' Case 56: FileExtStr = ".xls"
' Case 50: FileExtStr = ".xlsb"
' Case Else: FileExtStr = "notknown"
' End Select
End If

strDate = Format(Now, "_dd_mm_yyyy")

FileNameZip = DefPath & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & strDate & ".zip"

FileNamexls = DefPath & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & strDate & FileExtStr

If Dir(FileNameZip) = "" And Dir(FileNamexls) = "" Then

'Make copy of the activeworkbook
ActiveWorkbook.SaveCopyAs FileNamexls

'Create empty Zip File
NewZip (FileNameZip)

'Copy the file in the compressed folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameZip).CopyHere FileNamexls

'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0

'Delete the temporary xls file
Kill FileNamexls

End If
Windows(mSourceFileNameOnly).Activate
ActiveWorkbook.Close savechanges = False

End Sub
Sub DeleteZip(mFilePath)
Kill mFilePath
End Sub