I have code below to attach a PDF file which is to be selected in a folder "C:\my documents"
However when activating the macro, the worbook closes and I have to re-open
It would be appreciated if someone could kindly amend my code so s to alow me to select the file to attach
Sub Email_PDF_File()
Dim File As String, strBody As String, LR As Long
TheFile = Sheets("data").Range("A42")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
File = Environ$("temp") & "\" & Sheets("Data").Range("A42") & ".xlsx"
strBody = "Hi " & Sheets("Data").Range("AT1") & vbNewLine & vbNewLine & _
"Attached, please find PDF Journal Entries" & vbNewLine & vbNewLine & _
"Regards" & vbNewLine & vbNewLine & _
"Howard"
Set rng = Nothing
Sheets("Data").Range("Journals").Copy
Workbooks.Add
ActiveSheet.Range("a1").PasteSpecial xlPasteValues
ActiveSheet.Range("a1").PasteSpecial xlPasteFormats
ActiveSheet.Range("a1").PasteSpecial xlPasteColumnWidths
Sheets(1).Name = "Data"
LR = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
With ActiveWorkbook
With ActiveSheet.PageSetup
.PrintGridlines = True
.PrintArea = "A2:E" & LR + 10
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
.LeftHeader = "&D&T"
.CenterHeader = "Sales Journals"
.Orientation = xlLandscape
.FitToPagesWide = 1
End With
Sheets(1).Select
ActiveWindow.View = xlPageBreakPreview
.SaveAs Filename:=File, FileFormat:=51
.Close SaveChanges:=False
End With
DoEvents
With CreateObject("Outlook.Application").CreateItem(0)
ActiveWindow.View = xlPageBreakPreview
.To = Join(Application.Transpose(Sheets("Data").Range("AU1:AU2").Value), ";")
.Subject = Sheets("Data").Range("a42")
.body = strBody
.Attachments.Add File
DoEvents
.Display
End With
Kill File
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub [/code]
However when activating the macro, the worbook closes and I have to re-open
It would be appreciated if someone could kindly amend my code so s to alow me to select the file to attach
Sub Email_PDF_File()
Dim File As String, strBody As String, LR As Long
TheFile = Sheets("data").Range("A42")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
File = Environ$("temp") & "\" & Sheets("Data").Range("A42") & ".xlsx"
strBody = "Hi " & Sheets("Data").Range("AT1") & vbNewLine & vbNewLine & _
"Attached, please find PDF Journal Entries" & vbNewLine & vbNewLine & _
"Regards" & vbNewLine & vbNewLine & _
"Howard"
Set rng = Nothing
Sheets("Data").Range("Journals").Copy
Workbooks.Add
ActiveSheet.Range("a1").PasteSpecial xlPasteValues
ActiveSheet.Range("a1").PasteSpecial xlPasteFormats
ActiveSheet.Range("a1").PasteSpecial xlPasteColumnWidths
Sheets(1).Name = "Data"
LR = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
With ActiveWorkbook
With ActiveSheet.PageSetup
.PrintGridlines = True
.PrintArea = "A2:E" & LR + 10
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
.LeftHeader = "&D&T"
.CenterHeader = "Sales Journals"
.Orientation = xlLandscape
.FitToPagesWide = 1
End With
Sheets(1).Select
ActiveWindow.View = xlPageBreakPreview
.SaveAs Filename:=File, FileFormat:=51
.Close SaveChanges:=False
End With
DoEvents
With CreateObject("Outlook.Application").CreateItem(0)
ActiveWindow.View = xlPageBreakPreview
.To = Join(Application.Transpose(Sheets("Data").Range("AU1:AU2").Value), ";")
.Subject = Sheets("Data").Range("a42")
.body = strBody
.Attachments.Add File
DoEvents
.Display
End With
Kill File
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub [/code]