Note: The other languages of the website are Google-translated. Back to English
Se connecter  \/ 
x
or
x
INSCRIPTION  \/ 
x

or

Comment enregistrer une feuille de calcul en tant que fichier PDF et l'envoyer par e-mail en tant que pièce jointe via Outlook?

Dans certains cas, vous devrez peut-être envoyer une feuille de calcul sous forme de fichier PDF via Outlook. Habituellement, vous devez enregistrer manuellement la feuille de calcul en tant que fichier PDF, puis créer un nouvel e-mail avec ce fichier PDF en pièce jointe dans votre Outlook et enfin l'envoyer. Il faut du temps pour y parvenir manuellement étape par étape. Dans cet article, nous allons vous montrer comment enregistrer rapidement une feuille de calcul en tant que fichier PDF et l'envoyer automatiquement en tant que pièce jointe via Outlook dans Excel.

Enregistrez une feuille de calcul en tant que fichier PDF et envoyez-la par courrier électronique en tant que pièce jointe avec le code VBA


Enregistrez une feuille de calcul en tant que fichier PDF et envoyez-la par courrier électronique en tant que pièce jointe avec le code VBA


Vous pouvez exécuter le code VBA ci-dessous pour enregistrer automatiquement la feuille de calcul active en tant que fichier PDF, puis l'envoyer par courrier électronique en tant que pièce jointe via Outlook. Veuillez faire comme suit.

1. Ouvrez la feuille de calcul que vous allez enregistrer au format PDF et envoyer, puis appuyez sur le autre + F11 touches simultanément pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2. dans le Microsoft Visual Basic pour applications fenêtre, cliquez sur insérer > Module. Ensuite, copiez et collez le code VBA ci-dessous dans le Code la fenêtre. Voir la capture d'écran:

Code VBA: enregistrez une feuille de calcul en tant que fichier PDF et envoyez-la par e-mail en tant que pièce jointe

Sub Saveaspdfandsend()
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 = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .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

3. appuie sur le F5 clé pour exécuter le code. dans le DECOUVREZ boîte de dialogue, veuillez sélectionner un dossier pour enregistrer ce fichier PDF, puis cliquez sur le OK .

Notes:

1. La feuille de calcul active est maintenant enregistrée en tant que fichier PDF. Et le fichier PDF est nommé avec le nom de la feuille de calcul.
2. Si la feuille de calcul active est vide, vous obtiendrez une boîte de dialogue comme ci-dessous la capture d'écran affichée après avoir cliqué sur le OK .

4. Un nouvel e-mail Outlook est maintenant créé et vous pouvez voir que le fichier PDF est répertorié en tant que pièce jointe dans le fichier joint. Voir la capture d'écran:

5. Veuillez rédiger cet e-mail puis l'envoyer.
6. Ce code n'est disponible que lorsque vous utilisez Outlook comme programme de messagerie.

Enregistrez facilement une feuille de calcul ou plusieurs feuilles de calcul en tant que fichiers PDF distincts à la fois:

The Classeur fractionné utilité de Kutools pour Excel peut vous aider à enregistrer facilement une feuille de calcul ou plusieurs feuilles de calcul en tant que fichiers PDF séparés à la fois, comme le montre la démo ci-dessous. Téléchargez et essayez-le maintenant! (Parcours gratuit de 30 jours)


Articles connexes:


Les meilleurs outils de productivité de bureau

Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%

  • Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
  • Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtrée...
  • Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammes...
  • Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
  • Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
  • Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellules...
  • Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
  • Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDF...
  • Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2019 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
onglet kte 201905

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
bas de cabine
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Rueben · 2 months ago
    Hi

    Thanks for the code but I still having an issue emailing the doc in PDF straight after publishing. This is the  current code that I have. I copied the "send email"  code from this site.

    Dim wsA As Worksheet
    Dim wbA As Workbook
    Dim strName As String
    Dim strPath As String
    Dim strFile As String
    Dim strPathFile As String
    Dim myFile As Variant
    Dim xOutlookObj As Object
    Dim xEmailObj As Object
    Dim xUsedRng As Range
    Dim xStrName As String

    Dim x As Integer
    Application.ScreenUpdating = False


    ' Set numrows = number of rows of data.
    NumRows = Worksheets("DATA").Range("A2", Range("A2").End(xlDown)).Rows.Count
    ' Select cell a1.
    Range("A2").Select
    ' Establish "For" loop to loop "numrows" number of times.
    For x = 1 To NumRows
    'Reference
    Worksheets("Template").Cells(22, 5) = Worksheets("DATA").Cells(x + 1, 2)
    'Invoice Number
    Worksheets("Template").Cells(22, 7) = Worksheets("DATA").Cells(x + 1, 9)
    'Description
    Worksheets("Template").Cells(26, 1) = "HANDLING FEE:" & " " & Worksheets("DATA").Cells(x + 1, 6)
    'Amounts
    Worksheets("Template").Cells(26, 9) = Worksheets("DATA").Cells(x + 1, 4)

    ' Insert your code here.
    ' Selects cell down 1 row from active cell.
    ' ActiveCell.Offset(1, 0).Select
    Set wbA = ActiveWorkbook
    Set wsA = Worksheets("Template")


    'get active workbook folder, if saved
    ' On Error GoTo errHandler
    strPath = wbA.Path
    If strPath = "" Then
    strPath = Application.DefaultFilePath
    End If
    strPath = strPath & "\"
    Application.ScreenUpdating = True
    strName = wsA.Range("L1").Value _
    & " - " & wsA.Range("A2").Value _
    & " - " & wsA.Range("A3").Value

    'create default name for savng file
    strFile = strName & ".pdf"
    strPathFile = strPath & strFile

    'export to PDF in current folder
    wsA.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=strPathFile, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    'confirmation message with file info
    ' MsgBox "PDF file has been created: " _
    ' & vbCrLf _
    ' & strPathFile

    ' Create Outlook email

    Set OutMail = OutApp.CreateItem(0)

    strMsg = "Could not start mail for " _
    & c.Value
    On Error Resume Next
    With OutMail
    .To = "rueben06@gmail.com"
    .CC = ""
    .BCC = ""
    .Subject = strSubj
    .Body = strBody
    .Attachments.Add _
    strSavePath & strPDFName
    .Send
    End With
    On Error GoTo 0
    lSent = lSent + 1
    If lSent >= lCount Then Exit For


    MsgBox "The active worksheet cannot be blank"
    Exit Sub


    exitHandler:
    ' Set wsA = Worksheets("Template")
    'errHandler:
    ' MsgBox "Could not create PDF file"
    ' Resume exitHandler


    Next
    End Sub



  • To post as a guest, your comment is unpublished.
    Rod Bennett · 3 months ago
    Hi

    Many thanks for the Code but is it possible to save the the PDF automatically to the same location as the active Excel file and with the same file name as the active Excel file?

    Many thanks.

    Rod
  • To post as a guest, your comment is unpublished.
    Nicole · 3 months ago
    How do I edit this code to only save cells ("a1:r99") to save as the PDF. I have extra stuff on the sides I don't want in my PDF document.

    Sub Saveaspdfandsend()
    'Updated by Extendoffice 20210209
    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
    Dim xStrName As String
    Dim xV As Variant

    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
    xStrName = ""
    xV = Application.InputBox("Please enter the filename:", "Kutools for Excel", , , , , , 2)
    If xV = False Then
    Exit Sub
    End If
    xStrName = xV
    If xStrName = "" Then
    MsgBox ("No filename entered, exiting process!")
    Exit Sub
    End If

    xFolder = xFolder + "\" + xStrName + ".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 = ""
    .CC = ""
    .Subject = xSht.Name + ".pdf"
    .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
  • To post as a guest, your comment is unpublished.
    Makeeuropeanu · 5 months ago
    Hi,
    I needed something similar so here is what I got.
    It takes the current date and creates a new folder with the date name in a specific location.
    It places the pdf inside that new location, then attaches the pdf into a new email. 
    Works as a treat. 
    I am just a beginner so please excuse me if it looks like a mess. :D

    Sub PDFTOEMAIL()
    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
    Dim xPath As String
    Dim xOutMsg As String
    Dim sFolderName As String, sFolder As String
    Dim sFolderPath As String

    Set xSht = ActiveSheet
    xFileDate = Format(Now, "dd-mm-yyyy")
    sFolder = "C:" 'here is where you have a main folder
    sFolderName = "Week ending " + Format(Now, "dd-mm-yyyy") 'folder to be created in main folder with name Week ending and current date
    sFolderPath = "C:" & sFolderName 'main folder again to create the new path including the new folder
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FolderExists(sFolderPath) Then
    MsgBox "Folder already exists !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
    Else
    MkDir sFolderPath
    MsgBox "New folder has been created !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
    End If
    xPath = sFolderPath
    xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
    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
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    xOutMsg = "<b>Please find attached</b><br/><br/><br/><br/><br/><br/><br/><br/><br/><br/><br/><br/><span style=""color:#00FF00;background:#000000"">This email and attachment has been generated automatically</span>"
    'adds a note that the email was generated automatically

    With xEmailObj
    .Display
    .To = "" 'add your own emails
    .CC = ""
    .Subject = xSht.Name + " PDF for week ending " + xFileDate + " - Location " ' subject includes sheet name, pdf, date and location, this can be edited as needed
    .Attachments.Add xFolder
    .HTMLBody = xOutMsg & .HTMLBody
    If DisplayEmail = False Then
    '.Send <--- Here if you delete the apostrophe the email will be sent automatically, so please be careful
    End If
    End With
    Else
    MsgBox "The active worksheet cannot be blank"
    Exit Sub
    End If
    End Sub
  • To post as a guest, your comment is unpublished.
    Tori · 5 months ago
    Hi @crystal 

    This is fab - the o key thing I am struggling with is the file name - I’d like the file name to pull from a cell in the worksheet rather than use the tab name. I’ve already edited the code to save automatically to a specified folder but am struggling with the file name.

    Any help you can offer please?
    • To post as a guest, your comment is unpublished.
      crystal · 5 months ago
      Hi Tori,
      If you want to name the PDF file with a specific cell value, please try the following code.
      After running the code and selecting a folder to save the file, another dialog box pops up, please select the cell that you will use the value as the name of the PDF file, and then click OK to finish.

      Sub Saveaspdfandsend2() 'Updated by Extendoffice 20210521 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, xRgInser As Range Dim xB As Boolean 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 xB = True On Error Resume Next While xB Set xRgInser = Nothing Set xRgInser = Application.InputBox("Select a cell that you will use the value to name the PDF file:", "Kutools for Excel", , , , , , 8) If xRgInser Is Nothing Then MsgBox " No cell seleced, exit the operation! ", vbInformation, "Kutools for Excel" Exit Sub End If If xRgInser.Text = "" Then MsgBox " The selected cell is blank, please reselect! ", vbInformation, "Kutools for Excel" Else xB = False End If Wend xFolder = xFolder + "\" + xRgInser.Text + ".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 = "" .CC = "" .Subject = xSht.Name + ".pdf" .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
  • To post as a guest, your comment is unpublished.
    BenSpo · 5 months ago
    Hi @crystal , excelent code thanks for sharing.
    Is there a way to select multiples sheets (from the same workbook) to save each one as an independent PDF and then send them all attached in one email?
    • To post as a guest, your comment is unpublished.
      crystal · 5 months ago
      Hi,
      The below VBA code can do you a favor, please have a try.
      In the the twelfth line of the code, please replace the sheet names with the actual sheet names in your case.

      Sub Saveaspdfandsend1() Dim xSht As Worksheet Dim xFileDlg As FileDialog Dim xFolder As String Dim xYesorNo, I, xNum As Integer Dim xOutlookObj As Object Dim xEmailObj As Object Dim xUsedRng As Range Dim xArrShetts As Variant Dim xPDFNameAddress As String Dim xStr As String xArrShetts = Array("test", "Sheet1", "Sheet2") 'Enter the sheet names you will send as pdf files enclosed with quotation marks and separate them with comma. Make sure there is no special characters such as \/:"*<>| in the file name. For I = 0 To UBound(xArrShetts) On Error Resume Next Set xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I)) If xSht.Name <> xArrShetts(I) Then MsgBox "Worksheet no found, exit operation:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel" Exit Sub End If Next 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 'Check if file already exist xYesorNo = MsgBox("If same name files exist in the destination folder, number suffix will be added to the file name automatically to distinguish the duplicates" & vbCrLf & vbCrLf & "Click Yes to continue, click No to cancel", _ vbYesNo + vbQuestion, "File Exists") If xYesorNo <> vbYes Then Exit Sub For I = 0 To UBound(xArrShetts) Set xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I)) xStr = xFolder & "\" & xSht.Name & ".pdf" xNum = 1 While Not (Dir(xStr, vbDirectory) = vbNullString) xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf" xNum = xNum + 1 Wend Set xUsedRng = xSht.UsedRange If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xStr, Quality:=xlQualityStandard Else End If xArrShetts(I) = xStr Next 'Create Outlook email Set xOutlookObj = CreateObject("Outlook.Application") Set xEmailObj = xOutlookObj.CreateItem(0) With xEmailObj .Display .To = "" .CC = "" .Subject = "????" For I = 0 To UBound(xArrShetts) .Attachments.Add xArrShetts(I) Next If DisplayEmail = False Then '.Send End If End With End Sub

  • To post as a guest, your comment is unpublished.
    hein · 6 months ago
    Hello, i would like to save this in a certain file location, with the name based on the vallue in cell C30.
    I have tried a few options, but keep getting faults.
    • To post as a guest, your comment is unpublished.
      crystal · 6 months ago
      Hi hein,
      The below code maybe can help. After running the code, select a certain folder to save the PDF file, then a dialog box will pop up for you to enter the filename.
      Sub Saveaspdfandsend() 'Updated by Extendoffice 20210209 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 Dim xStrName As String Dim xV As Variant 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 xStrName = "" xV = Application.InputBox("Please enter the filename:", "Kutools for Excel", , , , , , 2) If xV = False Then Exit Sub End If xStrName = xV If xStrName = "" Then MsgBox ("No filename entered, exiting process!") Exit Sub End If xFolder = xFolder + "\" + xStrName + ".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 = "" .CC = "" .Subject = xSht.Name + ".pdf" .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
      • To post as a guest, your comment is unpublished.
        HeinPeeters · 6 months ago
        Thanks for that, thats great, but i want the sheet to be named as per cell A1 on sheet 1. the place to save as per A1 on sheet 2 for example C:\Users\peete\Dropbox\Screenshots, but can change when using the file, and email send to email address on A3 sheet 2 what I have worked out already.
      • To post as a guest, your comment is unpublished.
        Hein · 6 months ago
        Thanks for that, thats great, but i want the sheet to be named as per cell A1 on sheet 1. the place to save as per A1 on sheet 2 for example C:\Users\peete\Dropbox\Screenshots, and email send to email address on A3 sheet 2 what I have worked out already.
  • To post as a guest, your comment is unpublished.
    mleczus94 · 7 months ago
    Hi,
    If I have two sheets in file, and I would like to run this macro on one sheet(by pressing button) but send another, how can I get it?
  • To post as a guest, your comment is unpublished.
    deepakmaheshwari · 8 months ago

    Hi , it's working great thank you for sharing, Just need one help.
    If I want to save a PDF file with customized name (option to type file name in SaveAs dialog box), as user's use this option in form template where forms saved as PDF with unique name .
    • To post as a guest, your comment is unpublished.
      crystal · 8 months ago
      Hi,
      Please try the below VBA code. After running the code, select a folder to save the PDF file, then a dialog box will pop up for you to enter the filename.
      Sub Saveaspdfandsend() 'Updated by Extendoffice 20210209 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 Dim xStrName As String Dim xV As Variant 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 xStrName = "" xV = Application.InputBox("Please enter the filename:", "Kutools for Excel", , , , , , 2) If xV = False Then Exit Sub End If xStrName = xV If xStrName = "" Then MsgBox ("No filename entered, exiting process!") Exit Sub End If xFolder = xFolder + "\" + xStrName + ".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 = "" .CC = "" .Subject = xSht.Name + ".pdf" .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
  • To post as a guest, your comment is unpublished.
    Alison · 1 years ago
    This code works great except i want to have the worksheet saved as sheet name + date (ie. Sheet1 Oct 1 2020); on the user's desktop (this will be used by multiple people and their paths may vary slightly). If possible, i want to embed a .jpg into the body as well.. the JPG is located both inside the worksheet (outside of print area) and the image is stored on a shared server.. though the path to the server varies by user (for most it is a "T" drive for some a "U" drive)

    can this be done? please and thank you a million times.
  • To post as a guest, your comment is unpublished.
    Geoff · 1 years ago
    If I were wanting it to autosave in a specific folder each and every time (eliminating the need for the user to choose the folder), how would i do that?
    Ex. C: Invoices/NorthAmerica/Clients
    Help is greatly appreciated.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Geoff,
      If you want to automatically save the pdf file to a specific folder rather than selecting the location manually, please try the below code. Don't forget to change the folder path in the code.

      Sub SaveAsPDFandSend() 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 Dim xPath As String Set xSht = ActiveSheet xPath = "C:\Users\Win10x64Test\Desktop\worksheet to pdf" 'here "workshet to pdf" is the destination folder to save the pdf files xFolder = xPath + "\" + xSht.Name + ".pdf" 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 = "" .CC = "" .Subject = xSht.Name + ".pdf" .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
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Geoff,
      Do you mean save the worksheet as an pdf file and save into a specific folder without sending?
      • To post as a guest, your comment is unpublished.
        Jeremy · 1 years ago
        I think Geoff means being able to specific a specific folder in the code that the pdf is saved to each time rather than having to select the location manually. The pdf is then emailed from that specific folder.
        • To post as a guest, your comment is unpublished.
          crystal · 1 years ago
          Thank you Jeremy.
  • To post as a guest, your comment is unpublished.
    Kishore · 1 years ago
    Hi Crystal,

    It's really great and working perfectly for me. Need more help to add:

    1. in "Body" I want to give link to particular cell of Active sheet. Further Would like to Bold the text.

    Thanks

    Regards

    Kishore Kumar

    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi,
      Do you mean to add the cell value automatically to the mailbody and bold it? Supposing you add the value of C4 to the mail body. Please apply the below code.
      Sub Saveaspdfandsend()
      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 = ""
      .CC = ""
      .Subject = xSht.Name + ".pdf"
      .Attachments.Add xFolder
      .HTMLBody = "
      " & Range("C4") & .HTMLBody
      If DisplayEmail = False Then
      '.Send
      End If
      End With
      Else
      MsgBox "The active worksheet cannot be blank"
      Exit Sub
      End If
      End Sub
  • To post as a guest, your comment is unpublished.
    Odd-Inge · 2 years ago
    Hello,

    Is it possible to find the name for pdf from a cell? Ex. Cell H4


    And in Cell H4 i want it to collect from three different cells. Is this possible?
    • To post as a guest, your comment is unpublished.
      Taylor · 1 years ago
      This is possible. Make separate variables to hold the value from the cells and then use those variables when setting xFolder.
      I used the value from a cell in my sheet plus today's date. You could easily do multiple cell values though.

      This is what I added:
      Dim xMemberName As String
      Dim xFileDate As String

      xMemberName = Range("H3").Value
      xFileDate = Format(Now, "mm-dd")

      xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
  • To post as a guest, your comment is unpublished.
    Jason · 2 years ago
    How can I make it delete the saved pdf after it emails it?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Jason,
      Sorry can't help you with that yet. You need to manually delete it after emailing it.
  • To post as a guest, your comment is unpublished.
    ranga · 2 years ago
    Thanks it works.
  • To post as a guest, your comment is unpublished.
    james · 3 years ago
    Hi, how can i save & send the pdf wit the workbook name with the current VBA code? what do i use instead of xSht.Name
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi James,
      Do you want to send the active worksheet as pdf and name it as the workbook name?
  • To post as a guest, your comment is unpublished.
    Tom H · 3 years ago
    How would I edit the VBA script above so that the file name is saved as a specific cell selected within the current sheet, for example cell A1?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Tom.
      Sorry can’t help with this.
      Welcome to post any question in our forum: https://www.extendoffice.com/forum.html
      You will get more Excel support from out Excel professional or other Excel fans.
  • To post as a guest, your comment is unpublished.
    Armin · 3 years ago
    How can I add for example sheet 2 from the workbook as an pdf?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Armin,
      You need to open the Sheet 2 in your workbook firstly and then run the VBA code with above steps to get it down.
  • To post as a guest, your comment is unpublished.
    saultmc@gmail.com · 3 years ago
    How would I edit the VBA script above so that it adds a date and time stamp to the file name that way it doesn't keep overwriting what is already saved?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Michael,
      Please run the below VBA code to solve the problem.

      Sub Saveaspdfandsend()
      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
      Dim xStr As String

      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
      xStr = Format(Now(), "yyyy-mm-dd-hh-mm-ss")
      xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".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 = ""
      .CC = ""
      .Subject = xSht.Name + "-" + xStr + ".pdf"
      .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
      • To post as a guest, your comment is unpublished.
        parag1somani · 2 years ago
        Hi Crystal,

        It's really great and working perfectly for me. Need more help to add:

        1. in "To" I want to give link to particular cell of Active sheet like wise in CC and in BCC i would like to add active sheet link
        2. in e-mail body i need to specify some standard text.

        I will be great full to you for your help.

        Thanks
        Parag
      • To post as a guest, your comment is unpublished.
        Parag Somani · 2 years ago
        Hi Crystal,

        It's really great and working perfectly for me. Need more help to add:

        1. in "To" I want to give link to particular cell of Active sheet like wise in CC and in BCC i would like to add active sheet link
        2. in e-mail body i need to specify some standard text.

        I will be great full to you for your help.

        Thanks
        Parag
      • To post as a guest, your comment is unpublished.
        Parag Somani · 2 years ago
        Hi Crystal,

        It's really great and working perfectly for me. Need more help to add:

        1. in "To" I want to give link to particular cell of Active sheet like wise in CC and in BCC i would like to add active sheet link
        2. in e-mail body i need to specify some standard text.

        I will be great full to you for your help.

        Thanks
        Parag
        • To post as a guest, your comment is unpublished.
          crystal · 2 years ago
          Hi Parag Somani,
          The below VBA code can help you. Please change the .To, .CC, .BCC and .Body fields based on your needs.

          Sub Saveaspdfandsend()
          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
          Dim xStr As String

          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
          xStr = Format(Now(), "yyyy-mm-dd-hh-mm-ss")
          xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".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 = Range("A8")
          .CC = Range("A9")
          .BCC = Range("A10")
          .Subject = xSht.Name + "-" + xStr + ".pdf"
          .Body = "Dear " _
          & vbNewLine & vbNewLine & _
          "This is a test email " & _
          "sending in Excel"
          .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
  • To post as a guest, your comment is unpublished.
    Darren · 3 years ago
    I have tried pasting this into a new module and i get Compile error: Sub or Function not defined. Please help.
    • To post as a guest, your comment is unpublished.
      Bill · 2 years ago
      Same issue
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Darren,
      Which Office version do you use?
      • To post as a guest, your comment is unpublished.
        Nakia · 2 years ago
        Office 360
  • To post as a guest, your comment is unpublished.
    Michael · 4 years ago
    This is working great for me but is there a way to select a folder location automatically rather than select manually? I am hoping to do this for 40 sheets at once.
    • To post as a guest, your comment is unpublished.
      Hugh · 1 years ago
      Also hoping to see an answer for this issue! Thanks for the help!