VBA Help

[antmoss3]

Hi
Can someone spot what's wrong with the below? It's for saving a sheet as a PDF in a folder and then sending via outlook email.

 Sub RDB_Workbook_To_PDF_And_Create_Mail()
    Dim FileName As String
     'Call the function with the correct arguments
    FileName = RDB_Create_PDF(ActiveWorkbook, "S:\Logistics folder\COLLECTION_RETURNS_REQUESTS\" & Range("C12") & Format(Now(), " - dd-mm-yy") & ".pdf", True, True)
    If FileName <> "" Then
        RDB_Mail_PDF_Outlook FileName, "", "Collection/Return Request: " & Range("C12") & Format(Now(), " - dd-mm-yy"), _
        "Please find attached return request form." _
        & vbNewLine & vbNewLine & "Regards,  " & Range("C8"), False
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
        "Microsoft Add-in is not installed" & vbNewLine & _
        "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
        "The path to Save the file in arg 2 is not correct" & vbNewLine & _
        "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub
 
Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
    OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant
     'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
    & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
        If FixedFilePathName = "" Then
             'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
            Title:="Create PDF")
             'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If
         'If OverwriteIfFileExist = False we test if the PDF
         'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If
         'Now the file name is correct we Publish to PDF
        On Error Resume Next
        Myvar.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=Fname, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0
         'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
    End If
End Function
 
Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
    StrSubject As String, StrBody As String, Send As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = "logistics@brunierben.co.uk"
        .CC = "anthony.moss@brunierben.co.uk"
        .BCC = ""
        .Subject = StrSubject
        .Body = StrBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

I am getting the below error message:

Not possible to create the PDF, possible reasons:
Microsoft Add-in is not installed
You Canceled the GetSaveAsFilename dialog
The path to Save the file in arg 2 is not correct
You didn't want to overwrite the existing PDF if it exist

Any help much appreciated

 

[Kamolga]

To me the main reason would be the file "S:\Logistics folder\COLLECTION_RETURNS_REQUESTS" & Range("C12") & Format(Now(), " - dd-mm-yy") can not be done, so no access to S:\Logistics folder\COLLECTION_RETURNS_REQUESTS\ or your range C12 has invalid caracter

Another point is you need to activate the proper references to mail from excel.
Go in Visual basic and click reference in tools tab. There you need Microsoft Office 16.0 object library (or any version you have) and Microsof Oulook 16.0 object library (or any version you have) ticked

 

[antmoss3]

Thanks for your input however access is OK to the folder and no invalid characters. Object library also ticked...

To me the main reason would be the file "S:\Logistics folder\COLLECTION_RETURNS_REQUESTS" & Range("C12") & Format(Now(), " - dd-mm-yy") can not be done, so no access to S:\Logistics folder\COLLECTION_RETURNS_REQUESTS\ or your range C12 has invalid caracter

Another point is you need to activate the proper references to mail from excel.
Go in Visual basic and click reference in tools tab. There you need Microsoft Office 16.0 object library (or any version you have) and Microsof Oulook 16.0 object library (or any version you have) ticked

 

[antmoss3]

bump...any help much appreciated!

 

[Logit]

.
I'm not certain what is occuring with your code. Sorry. Below is a project I use for creating a PDF of a specified worksheet,
attaching to the email, then deletes the PDF file from the hard drive. Hopefully you can use this as a template for your project.

Note the sheet saved as a PDF is named EMAIL and derives its saved name from the value in cell B2.

Option Explicit


Sub pdf()
Dim wsA As Worksheet, wbA As Workbook, strTime As String
Dim strName As String, strPath As String
Dim strFile As String
Dim strPathFile As String




'On Error GoTo errHandler


    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet
    


'replace spaces and periods in sheet name
    strName = Replace(wsA.Name, " ", "")
    strName = Replace(strName, ".", "_")
    
'create default name for savng file
    strPath = "C:\PDFs\"
    strFile = Sheets("Email").Range("B2").Value
    strPathFile = strPath & strFile




Dim myFolder$
myFolder = "C:\PDFs"
    
    If Dir(myFolder, vbDirectory) = "" Then
         MkDir myFolder
    End If


'export to PDF if a folder was selected
    wsA.ExportAsFixedFormat 0, strPathFile
    
    If Len(Dir$(myFolder)) > 0 Then
        SetAttr myFolder, vbNormal
    End If


'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & strPathFile




exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub




Sub Mail_workbook_Outlook()


    Dim c As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strPath As String
    Dim FileName As String


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    strPath = "C:\PDFs\"
    FileName = Dir(strPath & "*.*")


    'On Error Resume Next
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = c.Value
            .CC = ""
            .BCC = ""
            .Subject = c.Offset(0, 1).Value
            .Body = "The parts have been placed on today's load sheet and will be processed by EOB today.  The parts have also been transferred to the repository file."
            FileName = Dir(strPath & "*.*")
            .Attachments.Add strPath & FileName
            
            '.Send                              '<-- .Send will auto send email without review
            .Display                            '<-- .Display will show the email first for review
        End With
        'On Error GoTo 0
    Next c




    Set OutMail = Nothing
    Set OutApp = Nothing
    
   byby
      
End Sub


Sub byby()  'deletes PDF file after attaching to email
Dim folder As Object
Dim path As String
path = "C:\PDFs"
Set folder = CreateObject("scripting.filesystemobject")


    folder.DeleteFolder path, True


End Sub

Download workbook : https://www.amazon.com/clouddrive/share/pfZ4dMJohnUTHLnqA3AJidTrMp5l2kIB3ifLur5uzzb