Changing code to suit? HELP Plzzz

[shanej2k]

Hi,

I have been given a new task as I'm the most IT literate in the office.
I've done a small bit of VERY basic VB coding/Macros.

I've stumbled across a code here and wanted to know how I could edit it and implement it to work for my use case.

I need to:
Export a PDF to the same location every time (OneDrive/SharePoint location).
Name it using 2 cells (one contains the road name, other contains the date i.e "BRoadName 22.03.2023")
Email it to 2 colleagues

I don't want the save dialog box to pop up I would just like a message to pop up saying it has been Saved as pdf, sent and uploaded to SharePoint.

Could someone else me with this please? TIA

 

[shanej2k]

Hi,

I have been given a new task as I'm the most IT literate in the office.
I've done a small bit of VERY basic VB coding/Macros.

I've stumbled across a code here and wanted to know how I could edit it and implement it to work for my use case.

I need to:
Export a PDF to the same location every time (OneDrive/SharePoint location).
Name it using 2 cells (one contains the road name, other contains the date i.e "BRoadName 22.03.2023")
Email it to 2 colleagues

I don't want the save dialog box to pop up I would just like a message to pop up saying it has been Saved as pdf, sent and uploaded to SharePoint.

Could someone else me with this please? TIA

Another thing to bear in mind this document has Multiple tabs/pages (approx 75) and will need this Button to work on each live page (once it's been edited).

 

[shanej2k]

Another thing to bear in mind this document has Multiple tabs/pages (approx 75) and will need this Button to work on each live page (once it's been edited).

Sub Export_Invoice()







Dim xSht As Worksheet

Dim xFileDlg As FileDialog

Dim xFolder As String

Dim xYesorNo As Integer

Dim xOutlookObj As Object

Dim xEmailObj As Object

Dim xUsedRng As Range



Set xSht = ActiveSheet

Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



If xFileDlg.Show = True Then

xFolder = xFileDlg.SelectedItems(1)

Else

MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"

Exit Sub

End If

xFolder = xFolder + "\" + xSht.Name + ".pdf"



'Check if file already exist

If Len(Dir(xFolder)) > 0 Then

xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _

vbYesNo + vbQuestion, "File Exists")

On Error Resume Next

If xYesorNo = vbYes Then

Kill xFolder

Else

MsgBox "if you don't overwrite the existing PDF, I can't continue." _

& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"

Exit Sub

End If

If Err.Number <> 0 Then

MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _

& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"

Exit Sub

End If

End If



Set xUsedRng = xSht.UsedRange

If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then

'Save as PDF file

xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard



'Create Outlook email

Set xOutlookObj = CreateObject("Outlook.Application")

Set xEmailObj = xOutlookObj.CreateItem(0)

With xEmailObj

.Display

.To = ActiveWorkbook.Sheets("Invoice Template").Range("C24")

.CC = "me@me.com"

.Subject = ActiveWorkbook.Sheets("Invoice Template").Range("C16")

.Attachments.Add xFolder

If DisplayEmail = False Then

'.Send

End If

End With

Else

MsgBox "The active worksheet cannot be blank"

Exit Sub

End If

End Sub