Note: The other languages of the website are Google-translated. Back to English
登入 立即註冊

如何將工作表另存為PDF文件並將其作為附件通過Outlook通過電子郵件發送？

在某些情況下，您可能需要通過Outlook將工作表作為PDF文件發送。 通常，您必須手動將工作表另存為PDF文件，然後在Outlook中使用帶有該PDF文件作為附件的新電子郵件來發送。 一步一步地手動實現它很耗時。 在本文中，我們將向您展示如何快速將工作表另存為PDF文件並自動將其作為附件通過Excel中的Outlook發送。

將工作表另存為PDF文件並通過VBA代碼作為附件通過電子郵件發送

將工作表另存為PDF文件並通過VBA代碼作為附件通過電子郵件發送

您可以運行下面的VBA代碼以將活動工作表自動保存為PDF文件，然後通過Outlook通過電子郵件將其作為附件發送。 請執行以下操作。

1.打開您將另存為PDF的工作表並發送，然後按 其他 + F11 同時打開 Microsoft Visual Basic for Applications 窗口。

2。 在裡面 Microsoft Visual Basic for Applications 窗口中，單擊 插入 > 模塊。 然後將以下VBA代碼複製並粘貼到 推薦碼 窗口。 看截圖：

VBA代碼：將工作表另存為PDF文件並通過電子郵件發送為附件

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。 按 F5 鍵來運行代碼。 在裡面 瀏覽 對話框，請選擇一個文件夾來保存此PDF文件，然後單擊 OK 按鈕。

筆記:

1.現在，活動工作表將另存為PDF文件。 PDF文件以工作表名稱命名。
2.如果活動工作表為空白，則單擊“確定”後將出現一個對話框，如下圖所示。 OK 按鈕。

4.現在，將創建新的Outlook電子郵件，您可以看到PDF文件作為附件列在附件字段中。 看截圖：

5.請撰寫此電子郵件，然後發送。
6.僅當使用Outlook作為郵件程序時，此代碼才可用。

一次輕鬆地將一個或多個工作表另存為單獨的PDF文件：

拆分工作簿 的效用 Excel的Kutools 可以幫助您輕鬆地一次將一個工作表或多個工作表另存為單獨的PDF文件，如下面的演示所示。 立即下載並試用！ (30-天自由行)

相關文章:

最佳辦公效率工具

Kutools for Excel 解決了你的大部分問題，並將你的生產力提高了 80%

  • 重用: 快速插入 複雜的公式，圖表 以及您以前使用過的任何東西； 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 超級公式欄 （輕鬆編輯多行文本和公式）； 閱讀版式 （輕鬆讀取和編輯大量單元格）； 粘貼到過濾範圍...
  • 合併單元格/行/列 不會丟失數據； 拆分單元格內容； 合併重複的行/列...防止細胞重複； 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 （所有單元格都是空的）； 超級查找和模糊查找 在許多工作簿中； 隨機選擇...
  • 確切的副本 多個單元格，無需更改公式參考； 自動創建參考 到多張紙； 插入項目符號，複選框等...
  • 提取文字，添加文本，按位置刪除， 刪除空間; 創建和打印分頁小計； 在單元格內容和註釋之間轉換...
  • 超級濾鏡 （將過濾方案保存並應用於其他工作表）； 高級排序 按月/週/日，頻率及更多； 特殊過濾器 用粗體，斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表； 將數據分割成多個工作表; 批量轉換xls，xlsx和PDF...
  • 超過 300 項強大的功能. 支持 Office / Excel 2007-2021 和 365。支持所有語言。 在您的企業或組織中輕鬆部署。 完整功能 30 天免費試用。 60 天退款保證。
kte選項卡201905

Office選項卡為Office帶來了選項卡式界面，使您的工作更加輕鬆

  • 在Word，Excel，PowerPoint中啟用選項卡式編輯和閱讀，發布者，Access，Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%，每天為您減少數百次鼠標點擊！
officetab底部
按評論排序
最舊的
最新的
留言 (63)
5中的5評分 · 1評級
邁克爾·
邁克爾·
網站主持人對此評論進行了最小化
這對我來說非常有用，但是有沒有辦法自動選擇文件夾位置而不是手動選擇？ 我希望一次做 40 張。
回复
0
0
休
休     邁克爾·
網站主持人對此評論進行了最小化
也希望看到這個問題的答案！ 謝謝您的幫助！
回复
0
0
達倫
達倫
網站主持人對此評論進行了最小化
我嘗試將其粘貼到新模塊中，但出現編譯錯誤：未定義子或函數。 請幫忙。
回复
0
0
水晶
水晶     達倫
網站主持人對此評論進行了最小化
親愛的達倫，
您使用哪個 Office 版本？
回复
即時報告
0
0
納基亞
納基亞     水晶
網站主持人對此評論進行了最小化
辦公室360
回复
0
0
海*飽飽
海*飽飽     達倫
網站主持人對此評論進行了最小化
同一期
回复
0
0
邁克爾·查里
邁克爾·查里
網站主持人對此評論進行了最小化
我將如何編輯上面的 VBA 腳本，以便它在文件名中添加日期和時間戳，這樣它就不會繼續覆蓋已經保存的內容？
回复
即時報告
0
0
水晶
水晶     邁克爾·查里
網站主持人對此評論進行了最小化
親愛的邁克爾，
請運行以下 VBA 代碼來解決問題。

子另存為pdfandsend()
將 xSht 調暗為工作表
將 xFileDlg 調暗為 FileDialog
將 xFolder 調暗為字符串
將 xYesorNo 調暗為整數
將 xOutlookObj 調暗為對象
將 xEmailObj 調暗為對象
將 xUsedRng 調暗為範圍
將 xStr 調暗為字符串

設置 xSht = ActiveSheet
設置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那麼
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必須指定一個文件夾來保存 PDF。" & vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "必須指定目標文件夾"
退出小組
如果結束
xStr = 格式（現在（），“yyyy-mm-dd-hh-mm-ss”）
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'檢查文件是否已經存在
如果 Len(Dir(xFolder)) > 0 那麼
xYesorNo = MsgBox(xFolder & " 已經存在。" & vbCrLf & vbCrLf & "你想覆蓋它嗎？", _
vbYesNo + vbQuestion, "文件存在")
在錯誤恢復下一頁
如果 xYesorNo = vbYes 那麼
殺死 xFolder
其他
MsgBox "如果您不覆蓋現有的 PDF，我將無法繼續。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小組
如果結束
如果 Err.Number <> 0 則
MsgBox "無法刪除現有文件。請確保文件未打開或未寫保護。" _
& vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "無法刪除文件"
退出小組
如果結束
如果結束

設置 xUsedRng = xSht.UsedRange
如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼
'另存為PDF文件
xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xFolder，質量：=xlQualityStandard

'創建 Outlook 電子郵件
設置 xOutlookObj = CreateObject("Outlook.Application")
設置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。顯示
.To = ""
.CC =“”
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Attachments.Add x文件夾
如果 DisplayEmail = False 那麼
'。發送
如果結束
結束
其他
MsgBox "活動工作表不能為空"
退出小組
如果結束
END SUB
回复
即時報告
0
0
帕拉格·索馬尼
帕拉格·索馬尼     水晶
網站主持人對此評論進行了最小化
嗨水晶，

這真的很棒，對我來說非常完美。 需要更多幫助來添加：

1. 在“收件人”中，我想在 CC 和 BCC 中提供指向活動工作表特定單元格的鏈接，我想添加活動工作錶鍊接
2. 在電子郵件正文中我需要指定一些標准文本。

我會很高興為您提供幫助。

謝謝
Parag
回复
0
0
水晶
水晶     帕拉格·索馬尼
網站主持人對此評論進行了最小化
嗨，帕拉格·索馬尼，
下面的 VBA 代碼可以幫助你。 請根據您的需要更改 .To、.CC、.BCC 和 .Body 字段。

子另存為pdfandsend()
將 xSht 調暗為工作表
將 xFileDlg 調暗為 FileDialog
將 xFolder 調暗為字符串
將 xYesorNo 調暗為整數
將 xOutlookObj 調暗為對象
將 xEmailObj 調暗為對象
將 xUsedRng 調暗為範圍
將 xStr 調暗為字符串

設置 xSht = ActiveSheet
設置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那麼
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必須指定一個文件夾來保存 PDF。" & vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "必須指定目標文件夾"
退出小組
如果結束
xStr = 格式（現在（），“yyyy-mm-dd-hh-mm-ss”）
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'檢查文件是否已經存在
如果 Len(Dir(xFolder)) > 0 那麼
xYesorNo = MsgBox(xFolder & " 已經存在。" & vbCrLf & vbCrLf & "你想覆蓋它嗎？", _
vbYesNo + vbQuestion, "文件存在")
在錯誤恢復下一頁
如果 xYesorNo = vbYes 那麼
殺死 xFolder
其他
MsgBox "如果您不覆蓋現有的 PDF，我將無法繼續。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小組
如果結束
如果 Err.Number <> 0 則
MsgBox "無法刪除現有文件。請確保文件未打開或未寫保護。" _
& vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "無法刪除文件"
退出小組
如果結束
如果結束

設置 xUsedRng = xSht.UsedRange
如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼
'另存為PDF文件
xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xFolder，質量：=xlQualityStandard

'創建 Outlook 電子郵件
設置 xOutlookObj = CreateObject("Outlook.Application")
設置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。顯示
.To = Range("A8")
.CC = 範圍（“A9”）
.BCC = 範圍（“A10”）
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Body =“親愛的”_
& vbNewLine & vbNewLine & _
“這是一封測試郵件” & _
“在 Excel 中發送”
.Attachments.Add x文件夾
如果 DisplayEmail = False 那麼
'。發送
如果結束
結束
其他
MsgBox "活動工作表不能為空"
退出小組
如果結束
END SUB
回复
即時報告
0
0
MEHUL
MEHUL     水晶
網站主持人對此評論進行了最小化
我一直在嘗試將 Range 用於“To”、“CC”，它只是沒有從指定的單元格中獲取值。 你能幫忙嗎？
謝謝，
MEHUL
回复
0
0
帕拉格·索馬尼
帕拉格·索馬尼     水晶
網站主持人對此評論進行了最小化
嗨水晶，

這真的很棒，對我來說非常完美。 需要更多幫助來添加：

1. 在“收件人”中，我想在 CC 和 BCC 中提供指向活動工作表特定單元格的鏈接，我想添加活動工作錶鍊接
2. 在電子郵件正文中我需要指定一些標准文本。

我會很高興為您提供幫助。

謝謝
Parag
回复
0
0
Parag
Parag     水晶
網站主持人對此評論進行了最小化
嗨水晶，

這真的很棒，對我來說非常完美。 需要更多幫助來添加：

1. 在“收件人”中，我想在 CC 和 BCC 中提供指向活動工作表特定單元格的鏈接，我想添加活動工作錶鍊接
2. 在電子郵件正文中我需要指定一些標准文本。

我會很高興為您提供幫助。

謝謝
Parag
回复
即時報告
0
0
阿明
阿明
網站主持人對此評論進行了最小化
例如，如何將工作簿中的工作表 2 添加為 pdf？
回复
0
0
水晶
水晶     阿明
網站主持人對此評論進行了最小化
嗨，阿明，
您需要先在工作簿中打開工作表 2，然後按照上述步驟運行 VBA 代碼以將其下載下來。
回复
即時報告
0
0
湯姆
湯姆
網站主持人對此評論進行了最小化
我將如何編輯上面的 VBA 腳本，以便將文件名保存為在當前工作表中選擇的特定單元格，例如單元格 A1？
回复
0
0
水晶
水晶     湯姆
網站主持人對此評論進行了最小化
你好湯姆。
抱歉幫不上忙。
歡迎在我們的論壇發表任何問題： https://www.extendoffice.com/forum.html
您將從 Excel 專業人士或其他 Excel 愛好者那裡獲得更多 Excel 支持。
回复
即時報告
0
0
詹姆斯
詹姆斯
網站主持人對此評論進行了最小化
嗨，我如何使用當前的 VBA 代碼保存並發送帶有工作簿名稱的 pdf？ 我用什麼代替 xSht.Name
回复
0
0
水晶
水晶     詹姆斯
網站主持人對此評論進行了最小化
嗨詹姆斯，
您想以 pdf 格式發送活動工作表並將其命名為工作簿名稱嗎？
回复
即時報告
0
0
朗高
朗高
網站主持人對此評論進行了最小化
謝謝它的工作原理。
回复
0
0
賈森
賈森
網站主持人對此評論進行了最小化
我怎樣才能讓它在它通過電子郵件發送後刪除保存的pdf？
回复
0
0
水晶
水晶     賈森
網站主持人對此評論進行了最小化
嗨，賈森，
抱歉還不能幫你。 您需要在通過電子郵件發送後手動刪除它。
回复
即時報告
0
0
奇數
奇數
網站主持人對此評論進行了最小化
你好，

是否可以從單元格中找到 pdf 的名稱？ 前任。 單元格 H4


在單元格 H4 中，我希望它從三個不同的單元格中收集。 這可能嗎？
回复
0
0
泰勒
泰勒     奇數
網站主持人對此評論進行了最小化
這個有可能。 創建單獨的變量以保存單元格中的值，然後在設置 xFolder 時使用這些變量。
我使用了工作表中單元格中的值加上今天的日期。 不過，您可以輕鬆地執行多個單元格值。

這是我添加的：
將 xMemberName 調暗為字符串
將 xFileDate 調暗為字符串

xMemberName = Range("H3").Value
xFileDate = 格式（現在，“mm-dd”）

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
回复
0
0
空
空     泰勒
網站主持人對此評論進行了最小化
嘗試此操作時出現錯誤，我應該將其放置在代碼的哪個位置？
回复
0
0
基肖爾
基肖爾
網站主持人對此評論進行了最小化
嗨水晶，



這真的很棒，對我來說非常完美。 需要更多幫助來添加：

1.在“正文”中，我想給出活動表的特定單元格的鏈接。 進一步想加粗文本。

謝謝

問候

Kishore庫馬爾
回复
即時報告
0
0
水晶
水晶     基肖爾
網站主持人對此評論進行了最小化
嗨，

您的意思是自動將單元格值添加到郵件正文並加粗嗎？ 假設您將 C4 的值添加到郵件正文。 請應用以下代碼。

子另存為pdfandsend()

將 xSht 調暗為工作表

將 xFileDlg 調暗為 FileDialog

將 xFolder 調暗為字符串

將 xYesorNo 調暗為整數

將 xOutlookObj 調暗為對象

將 xEmailObj 調暗為對象

將 xUsedRng 調暗為範圍



設置 xSht = ActiveSheet

設置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



如果 xFileDlg.Show = True 那麼

xFolder = xFileDlg.SelectedItems(1)

其他

MsgBox "您必須指定一個文件夾來保存 PDF。" & vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "必須指定目標文件夾"

退出小組

如果結束

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



'檢查文件是否已經存在

如果 Len(Dir(xFolder)) > 0 那麼

xYesorNo = MsgBox(xFolder & " 已經存在。" & vbCrLf & vbCrLf & "你想覆蓋它嗎？", _

vbYesNo + vbQuestion, "文件存在")

在錯誤恢復下一頁

如果 xYesorNo = vbYes 那麼

殺死 xFolder

其他

MsgBox "如果您不覆蓋現有的 PDF，我將無法繼續。" _

& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"

退出小組

如果結束

如果 Err.Number <> 0 則

MsgBox "無法刪除現有文件。請確保文件未打開或未寫保護。" _

& vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "無法刪除文件"

退出小組

如果結束

如果結束



設置 xUsedRng = xSht.UsedRange

如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼

'另存為PDF文件

xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xFolder，質量：=xlQualityStandard



'創建 Outlook 電子郵件

設置 xOutlookObj = CreateObject("Outlook.Application")

設置 xEmailObj = xOutlookObj.CreateItem(0)

使用 xEmailObj

。顯示

.To = ""

.CC =“”

.Subject = xSht.Name + ".pdf"

.Attachments.Add x文件夾

.HTMLBody = "
" & Range("C4") & .HTMLBody

如果 DisplayEmail = False 那麼

'。發送

如果結束

結束

其他

MsgBox "活動工作表不能為空"

退出小組

如果結束

END SUB
回复
即時報告
0
0
傑夫
傑夫
網站主持人對此評論進行了最小化
如果我希望它每次都自動保存在特定文件夾中（消除用戶選擇文件夾的需要），我該怎麼做？
前任。 C：發票/北美/客戶
非常感謝幫助。
回复
0
0
水晶
水晶     傑夫
網站主持人對此評論進行了最小化
嗨，傑夫，
您的意思是將工作表另存為 pdf 文件並保存到特定文件夾而不發送？
回复
即時報告
0
0
傑里米
傑里米     水晶
網站主持人對此評論進行了最小化
我認為 Geoff 意味著能夠在每次保存 pdf 的代碼中指定特定文件夾，而不必手動選擇位置。 然後從該特定文件夾通過電子郵件發送 pdf。
回复
0
0
水晶
水晶     傑里米
網站主持人對此評論進行了最小化
謝謝杰里米。
回复
即時報告
0
0
水晶
水晶     傑夫
網站主持人對此評論進行了最小化
嗨 Geoff，如果您想自動將 pdf 文件保存到特定文件夾而不是手動選擇位置，請嘗試以下代碼。 不要忘記更改代碼中的文件夾路徑。
子 SaveAsPDFandSend()
將 xSht 調暗為工作表
將 xFileDlg 調暗為 FileDialog
將 xFolder 調暗為字符串
將 xYesorNo 調暗為整數
將 xOutlookObj 調暗為對象
將 xEmailObj 調暗為對象
將 xUsedRng 調暗為範圍
將 xPath 調暗為字符串
設置 xSht = ActiveSheet
xPath = "C:\Users\Win10x64Test\Desktop\worksheet 轉 pdf" '這裡的“工作表到pdf”是保存pdf文件的目標文件夾
xFolder = xPath + "\" + xSht.Name + ".pdf"
如果 Len(Dir(xFolder)) > 0 那麼
xYesorNo = MsgBox(xFolder & " 已經存在。" & vbCrLf & vbCrLf & "你想覆蓋它嗎？", _
vbYesNo + vbQuestion, "文件存在")
在錯誤恢復下一頁
如果 xYesorNo = vbYes 那麼
殺死 xFolder
其他
MsgBox "如果您不覆蓋現有的 PDF，我將無法繼續。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小組
如果結束
如果 Err.Number <> 0 則
MsgBox "無法刪除現有文件。請確保文件未打開或未寫保護。" _
& vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "無法刪除文件"
退出小組
如果結束
如果結束

設置 xUsedRng = xSht.UsedRange
如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼
'另存為PDF文件
xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xFolder，質量：=xlQualityStandard

'創建 Outlook 電子郵件
設置 xOutlookObj = CreateObject("Outlook.Application")
設置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。顯示
.To = ""
.CC =“”
.Subject = xSht.Name + ".pdf"
.Attachments.Add x文件夾
如果 DisplayEmail = False 那麼
'。發送
如果結束
結束
其他
MsgBox "活動工作表不能為空"
退出小組
如果結束
END SUB
回复
即時報告
0
0
艾莉森
艾莉森
網站主持人對此評論進行了最小化
此代碼效果很好，除了我想將工作表另存為工作表名稱 + 日期（即 Sheet1 Oct 1 2020）； 在用戶的桌面上（這將被多人使用，他們的路徑可能略有不同）。 如果可能的話，我也想將 .jpg 嵌入到正文中.. JPG 位於工作表內部（打印區域之外），並且圖像存儲在共享服務器上.. 雖然服務器的路徑因用戶（對於某些“U”驅動器來說，它是“T”驅動器）
可以這樣做嗎？ 請並感謝你一百萬次。
回复
0
0
迪帕克
迪帕克
網站主持人對此評論進行了最小化

嗨，它工作得很好，謝謝你的分享，只需要一個幫助。
如果我想使用自定義名稱保存 PDF 文件（在 SaveAs 對話框中鍵入文件名的選項），因為用戶在表單模板中使用此選項，其中表單保存為具有唯一名稱的 PDF。
回复
即時報告
0
0
水晶
水晶     迪帕克
網站主持人對此評論進行了最小化
嗨，請嘗試下面的 VBA 代碼。 運行代碼後，選擇一個文件夾來保存PDF文件，然後會彈出一個對話框讓您輸入文件名。 Sub Saveaspdfandsend()
'更新者 Extendoffice 20210209
將 xSht 調暗為工作表
將 xFileDlg 調暗為 FileDialog
將 xFolder 調暗為字符串
將 xYesorNo 調暗為整數
將 xOutlookObj 調暗為對象
將 xEmailObj 調暗為對象
將 xUsedRng 調暗為範圍
將 xStrName 調暗為字符串
將 xV 變暗為變體

設置 xSht = ActiveSheet
設置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那麼
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必須指定一個文件夾來保存 PDF。" & vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "必須指定目標文件夾"
退出小組
如果結束
xStrName = ""
xV = Application.InputBox("請輸入文件名:", "Kutools for Excel", , , , , , 2)
如果 xV = False 那麼
退出小組
如果結束
xStrName = xV
如果 xStrName = "" 那麼
MsgBox ("沒有輸入文件名，正在退出進程！")
退出小組
如果結束

xFolder = xFolder + "\" + xStrName + ".pdf"
'檢查文件是否已經存在
如果 Len(Dir(xFolder)) > 0 那麼
xYesorNo = MsgBox(xFolder & " 已經存在。" & vbCrLf & vbCrLf & "你想覆蓋它嗎？", _
vbYesNo + vbQuestion, "文件存在")
在錯誤恢復下一頁
如果 xYesorNo = vbYes 那麼
殺死 xFolder
其他
MsgBox "如果您不覆蓋現有的 PDF，我將無法繼續。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小組
如果結束
如果 Err.Number <> 0 則
MsgBox "無法刪除現有文件。請確保文件未打開或未寫保護。" _
& vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "無法刪除文件"
退出小組
如果結束
如果結束

設置 xUsedRng = xSht.UsedRange
如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼
'另存為PDF文件
xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xFolder，質量：=xlQualityStandard

'創建 Outlook 電子郵件
設置 xOutlookObj = CreateObject("Outlook.Application")
設置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。顯示
.To = ""
.CC =“”
.Subject = xSht.Name + ".pdf"
.Attachments.Add x文件夾
如果 DisplayEmail = False 那麼
'。發送
如果結束
結束
其他
MsgBox "活動工作表不能為空"
退出小組
如果結束
END SUB
回复
即時報告
0
0
Mleczus94
Mleczus94
網站主持人對此評論進行了最小化
嗨，
如果我在文件中有兩張紙，我想在一張紙上運行這個宏（通過按下按鈕）但發送另一張，我怎樣才能得到它？
回复
即時報告
0
0
呵呵
呵呵
網站主持人對此評論進行了最小化
您好，我想將其保存在某個文件位置，名稱基於單元格 C30 中的值。我嘗試了一些選項，但不斷出現故障。
回复
0
0
水晶
水晶     呵呵
網站主持人對此評論進行了最小化
嗨，hein，下面的代碼可能會有所幫助。 運行代碼後，選擇某個文件夾保存PDF文件，然後會彈出一個對話框讓您輸入文件名。 Sub Saveaspdfandsend()
'更新者 Extendoffice 20210209
將 xSht 調暗為工作表
將 xFileDlg 調暗為 FileDialog
將 xFolder 調暗為字符串
將 xYesorNo 調暗為整數
將 xOutlookObj 調暗為對象
將 xEmailObj 調暗為對象
將 xUsedRng 調暗為範圍
將 xStrName 調暗為字符串
將 xV 變暗為變體

設置 xSht = ActiveSheet
設置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那麼
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必須指定一個文件夾來保存 PDF。" & vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "必須指定目標文件夾"
退出小組
如果結束
xStrName = ""
xV = Application.InputBox("請輸入文件名:", "Kutools for Excel", , , , , , 2)
如果 xV = False 那麼
退出小組
如果結束
xStrName = xV
如果 xStrName = "" 那麼
MsgBox ("沒有輸入文件名，正在退出進程！")
退出小組
如果結束

xFolder = xFolder + "\" + xStrName + ".pdf"
'檢查文件是否已經存在
如果 Len(Dir(xFolder)) > 0 那麼
xYesorNo = MsgBox(xFolder & " 已經存在。" & vbCrLf & vbCrLf & "你想覆蓋它嗎？", _
vbYesNo + vbQuestion, "文件存在")
在錯誤恢復下一頁
如果 xYesorNo = vbYes 那麼
殺死 xFolder
其他
MsgBox "如果您不覆蓋現有的 PDF，我將無法繼續。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小組
如果結束
如果 Err.Number <> 0 則
MsgBox "無法刪除現有文件。請確保文件未打開或未寫保護。" _
& vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "無法刪除文件"
退出小組
如果結束
如果結束

設置 xUsedRng = xSht.UsedRange
如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼
'另存為PDF文件
xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xFolder，質量：=xlQualityStandard

'創建 Outlook 電子郵件
設置 xOutlookObj = CreateObject("Outlook.Application")
設置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。顯示
.To = ""
.CC =“”
.Subject = xSht.Name + ".pdf"
.Attachments.Add x文件夾
如果 DisplayEmail = False 那麼
'。發送
如果結束
結束
其他
MsgBox "活動工作表不能為空"
退出小組
如果結束
END SUB
回复
即時報告
0
0
海恩
海恩     水晶
網站主持人對此評論進行了最小化
謝謝你，太好了，但我希望工作表按照工作表 1 上的單元格 A1 命名。按照工作表 1 上的 A2 保存的位置，例如 C:\Users\peete\Dropbox\Screenshots，並通過電子郵件發送到A3 表 2 上的電子郵件地址我已經制定了。
回复
0
0
海因彼特
海因彼特     水晶
網站主持人對此評論進行了最小化
謝謝你，那太好了，但我希望工作表按照工作表 1 上的單元格 A1 命名。按照工作表 1 上的 A2 保存的位置，例如 C:\Users\peete\Dropbox\Screenshots，但可以更改時間使用該文件，並將電子郵件發送到 A3 表 2 上的電子郵件地址，這是我已經制定的。
回复
即時報告
0
0
本斯波
本斯波
網站主持人對此評論進行了最小化
Hi 水晶 ，優秀的代碼感謝分享。有沒有辦法選擇多張工作表（來自同一個工作簿）以將每一張保存為獨立的 PDF，然後將它們全部發送到一封電子郵件中？
回复
即時報告
0
0
水晶
水晶     本斯波
網站主持人對此評論進行了最小化
您好，下面的 VBA 代碼可以幫到您，請試一試。在代碼的第 XNUMX 行，請將工作表名稱替換為您的實際工作表名稱。
Sub Saveaspdfandsend1()
將 xSht 調暗為工作表
將 xFileDlg 調暗為 FileDialog
將 xFolder 調暗為字符串
將 xYesorNo, I, xNum 調暗為整數
將 xOutlookObj 調暗為對象
將 xEmailObj 調暗為對象
將 xUsedRng 調暗為範圍
將 xArrShetts 調暗為變體
將 xPDFNameAddress 調暗為字符串
將 xStr 調暗為字符串
xArrShetts = 數組（“測試”, “表 1”, “表 2”) '輸入您將作為 pdf 文件發送的工作表名稱，並用引號括起來並用逗號分隔。 確保文件名中沒有特殊字符，例如 \/:"*<>|。

對於 I = 0 到 UBound(xArrShetts)
在錯誤恢復下一頁
設置 xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
如果 xSht.Name <> xArrShetts(I) 那麼
MsgBox "未找到工作表，退出操作：" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
退出小組
如果結束
下一頁


設置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFileDlg.Show = True 那麼
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必須指定一個文件夾來保存 PDF。" & vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "必須指定目標文件夾"
退出小組
如果結束
'檢查文件是否已經存在
xYesorNo = MsgBox("如果目標文件夾中存在同名文件，則會在文件名中自動添加數字後綴以區分重複" & vbCrLf & vbCrLf & "單擊是繼續，單擊否取消", _
vbYesNo + vbQuestion, "文件存在")
If xYesorNo <> vbYes Then Exit Sub
對於 I = 0 到 UBound(xArrShetts)
設置 xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
x數 = 1
雖然不是（Dir（xStr，vbDirectory）= vbNullString）
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
申請
設置 xUsedRng = xSht.UsedRange
如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼
xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xStr，質量：=xlQualityStandard
其他

如果結束
xArrShetts(I) = xStr
下一頁

'創建 Outlook 電子郵件
設置 xOutlookObj = CreateObject("Outlook.Application")
設置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。顯示
.To = ""
.CC =“”
.Subject = "????"
對於 I = 0 到 UBound(xArrShetts)
.Attachments.Add xArrShetts(一)
下一頁
如果 DisplayEmail = False 那麼
'。發送
如果結束
結束
END SUB
回复
即時報告
0
0
伯尼·魯道夫
伯尼·魯道夫     水晶
網站主持人對此評論進行了最小化
嗨，我正在努力解決的一個變化是為每個創建的 pdf 文檔創建一個單獨的電子郵件。
回复
0
0
水晶
水晶     伯尼·魯道夫
網站主持人對此評論進行了最小化
嗨，要為每個 pdf 文檔創建單獨的電子郵件，您可以在不同的工作表中手動運行帖子中提供的 VBA 來完成它。
回复
即時報告
0
0
伯尼·魯道夫
伯尼·魯道夫     水晶
網站主持人對此評論進行了最小化
我的工作簿中有 100 多個工作表，這意味著我必須運行 VBA 超過 100 次，這很耗時。  
我設法將我的工作簿拆分為多個工作表，然後我能夠將每個工作表轉換為一個單獨的 PDF 文檔。
我正在尋找的解決方案是在上述過程運行時分別通過電子郵件發送每個 PDF 文檔。
我目前正在運行的 VBA：
子另存為pdfandsend1()
將 xSht 調暗為工作表
將 xFileDlg 調暗為 FileDialog
將 xFolder 調暗為字符串
將 xYesorNo, I, xNum 調暗為整數
將 xOutlookObj 調暗為對象
將 xEmailObj 調暗為對象
將 xUsedRng 調暗為範圍
將 xArrShetts 調暗為變體
將 xPDFNameAddress 調暗為字符串
將 xStr 調暗為字符串
xArrShetts = 數組（“02302257”、“02400438”、“02401829”、“02403995”、“02408001”、“02409208”、_
“02409980”、“02411881”、“02424178”、“02430454”、“02444046”、“02448950”、“02450600”、_
“02459861”、“02461750”、“02467535”、“02480484”、“02484749”、“02502041”、“02504807”、_
“02511843”、“02515193”、“02523098”、“02523244”、“02524036”、“02524548”、“02525516”、“02525703”、“02525898”、“02528908”、“02528950”、_
“02530381”、“02531018”、“02531252”、“02531277”、“02532571”、“02533053”、“02533474”、_
“02534176”、“02534592”、“02534626”、“02535343”、“02536386”、“02536921”、“02537544”、_
“02537607”、“02538015”、“02538755”、“02538836”、“02538910”、“02539685”、“02540063”、“02540139”、“02540158”、“02541607”、“02542344”、_
“02543763”、“02543985”、“02544116”、“02544748”、“02544762”、“02545026”、“02545048”、_
“02545080”、“02545447”、“02545730”、“02545814”、“02546477”、“02547458”、“02547673”、_
“02547833”、“02547912”、“02547950”、“02547991”、“02548848”、“02549103”、“02549116”、“02549125”、“02549132”、“02549140”、“02549182”、_
“02549462”、“02549499”、“02549565”、“02549687”、“02550049”、“02550437”、“02550812”、_
“02550982”、“02551004”、“02551005”、“02551045”、“02552099”、“02552222”、“02552561”、_
“02552684”、“02552815”、“02552892”、“02553031”、“02553186”、“02553628”、“02553721”、“02555186”、“02556934”、“02557137”、“02557393”、_
“02559121”、“02559392”、“02559419”、“02559512”、“02559802”、“02559868”、“02560052”、_
“02560612”、“02560684”、“02560920”、“02561018”、“02561061”、“02561092”、“02561227”、_
“02561349”、“02561592”、“02561630”、“02561673”、“02561880”、“02562359”、“02562920”、“02562934”、“02563013”、“02563119”、“02563133”、_
“02563445”、“02563737”、“02563828”、“02563852”、“02563861”、“02563971”、“02564042”、_
"02564315"、"02564366"、"02564832"、"02564909"、"02565059"、"02565205") '輸入您將作為 pdf 文件發送的工作表名稱，並用引號括起來並用逗號分隔。 確保文件名中沒有特殊字符，例如 \/:"*<>|。

對於 I = 0 到 UBound(xArrShetts)
在錯誤恢復下一頁
設置 xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
如果 xSht.Name <> xArrShetts(I) 那麼
MsgBox "未找到工作表，退出操作：" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
退出小組
如果結束
下一頁


設置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFileDlg.Show = True 那麼
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必須指定一個文件夾來保存 PDF。" & vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "必須指定目標文件夾"
退出小組
如果結束
'檢查文件是否已經存在
xYesorNo = MsgBox("如果目標文件夾中存在同名文件，則會在文件名中自動添加數字後綴以區分重複" & vbCrLf & vbCrLf & "單擊是繼續，單擊否取消", _
vbYesNo + vbQuestion, "文件存在")
If xYesorNo <> vbYes Then Exit Sub
對於 I = 0 到 UBound(xArrShetts)
設置 xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
x數 = 1
雖然不是（Dir（xStr，vbDirectory）= vbNullString）
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
申請
設置 xUsedRng = xSht.UsedRange
如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼
xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xStr，質量：=xlQualityStandard
其他

如果結束
xArrShetts(I) = xStr
下一頁

'創建 Outlook 電子郵件
設置 xOutlookObj = CreateObject("Outlook.Application")
設置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。顯示
.To = "Ctracklegal@ctrack.com"
.CC =“”
.Subject = "????"
對於 I = 0 到 UBound(xArrShetts)
在錯誤恢復下一頁
.Attachments.Add xArrShetts(一)
下一頁
如果 DisplayEmail = False 那麼
。發送
退出小組
如果結束
結束


END SUB
回复
0
0
東籬
東籬
網站主持人對此評論進行了最小化
嗨@水晶
這是 fab - 我正在努力解決的關鍵問題是文件名 - 我希望文件名從工作表中的單元格中提取，而不是使用選項卡名稱。 我已經編輯了代碼以自動保存到指定的文件夾，但正在為文件名而苦苦掙扎。
請問您能提供什麼幫助嗎？
回复
0
0
水晶
水晶     東籬
網站主持人對此評論進行了最小化
您好 Tori，如果您想用特定的單元格值命名 PDF 文件，請嘗試以下代碼。運行代碼並選擇一個文件夾來保存文件後，會彈出另一個對話框，請選擇您將使用的單元格該值作為 PDF 文件的名稱，然後單擊“確定”完成。
Sub Saveaspdfandsend2()
'更新者 Extendoffice 20210521
將 xSht 調暗為工作表
將 xFileDlg 調暗為 FileDialog
將 xFolder 調暗為字符串
將 xYesorNo 調暗為整數
將 xOutlookObj 調暗為對象
將 xEmailObj 調暗為對象
將 xUsedRng、xRgInser 調暗為範圍
將 xB 調暗為布爾值
設置 xSht = ActiveSheet
設置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那麼
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必須指定一個文件夾來保存 PDF。" & vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "必須指定目標文件夾"
退出小組
如果結束
xB = 真
在錯誤恢復下一頁
而xB
設置 xRgInser = 無
Set xRgInser = Application.InputBox("選擇一個單元格，您將使用該值來命名 PDF 文件：", "Kutools for Excel", , , , , , 8)
如果 xRgInser 什麼都不是，那麼
MsgBox "沒有選擇單元格，退出操作！", vbInformation, "Kutools for Excel"
退出小組
如果結束
如果 xRgInser.Text = "" 那麼
MsgBox "所選單元格為空白，請重新選擇！", vbInformation, "Kutools for Excel"
其他
xB = 假
如果結束
申請

xFolder = xFolder + "\" + xRgInser.Text + ".pdf"

'檢查文件是否已經存在
如果 Len(Dir(xFolder)) > 0 那麼
xYesorNo = MsgBox(xFolder & " 已經存在。" & vbCrLf & vbCrLf & "你想覆蓋它嗎？", _
vbYesNo + vbQuestion, "文件存在")
在錯誤恢復下一頁
如果 xYesorNo = vbYes 那麼
殺死 xFolder
其他
MsgBox "如果您不覆蓋現有的 PDF，我將無法繼續。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小組
如果結束
如果 Err.Number <> 0 則
MsgBox "無法刪除現有文件。請確保文件未打開或未寫保護。" _
& vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "無法刪除文件"
退出小組
如果結束
如果結束

設置 xUsedRng = xSht.UsedRange
如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼
'另存為PDF文件
xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xFolder，質量：=xlQualityStandard

'創建 Outlook 電子郵件
設置 xOutlookObj = CreateObject("Outlook.Application")
設置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。顯示
.To = ""
.CC =“”
.Subject = xSht.Name + ".pdf"
.Attachments.Add x文件夾
如果 DisplayEmail = False 那麼
'。發送
如果結束
結束
其他
MsgBox "活動工作表不能為空"
退出小組
如果結束
END SUB
回复
即時報告
0
0
馬克歐佩努
馬克歐佩努
網站主持人對此評論進行了最小化
嗨，我需要類似的東西，所以這就是我得到的。它採用當前日期並在特定位置創建一個帶有日期名稱的新文件夾。它將 pdf 放在該新位置，然後將 pdf 附加到新電子郵件中。 作為一種享受。 我只是一個初學者，所以如果它看起來一團糟，請原諒我。 :D
子 PDFTOEMAIL()
將 xSht 調暗為工作表
將 xFileDlg 調暗為 FileDialog
將 xFolder 調暗為字符串
將 xYesorNo 調暗為整數
將 xOutlookObj 調暗為對象
將 xEmailObj 調暗為對象
將 xUsedRng 調暗為範圍
將 xPath 調暗為字符串
將 xOutMsg 調暗為字符串
將 sFolderName 作為字符串調暗，將 sFolder 作為字符串調暗
將 sFolderPath 調暗為字符串

設置 xSht = ActiveSheet
xFileDate = 格式（現在，“dd-mm-yyyy”）
sFolder = "C:" '這裡有一個主文件夾
sFolderName = "週結束" + Format(Now, "dd-mm-yyyy") '要在主文件夾中創建的文件夾，名稱為周結束和當前日期
sFolderPath = "C:" & sFolderName '主文件夾再次創建包含新文件夾的新路徑
設置 oFSO = CreateObject("Scripting.FileSystemObject")
如果 oFSO.FolderExists(sFolderPath) 那麼
MsgBox "文件夾已經存在！" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
其他
MkDir s文件夾路徑
MsgBox "新文件夾已創建！" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
如果結束
xPath = s文件夾路徑
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
如果 Len(Dir(xFolder)) > 0 那麼
xYesorNo = MsgBox(xFolder & " 已經存在。" & vbCrLf & vbCrLf & "你想覆蓋它嗎？", _
vbYesNo + vbQuestion, "文件存在")
在錯誤恢復下一頁
如果 xYesorNo = vbYes 那麼
殺死 xFolder
其他
MsgBox "如果您不覆蓋現有的 PDF，我將無法繼續。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小組
如果結束
如果 Err.Number <> 0 則
MsgBox "無法刪除現有文件。請確保文件未打開或未寫保護。" _
& vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "無法刪除文件"
退出小組
如果結束
如果結束

設置 xUsedRng = xSht.UsedRange
如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼
xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xFolder，質量：=xlQualityStandard
設置 xOutlookObj = CreateObject("Outlook.Application")
設置 xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = "請查看附件此電子郵件和附件已自動生成“
'添加一個說明電子郵件是自動生成的

使用 xEmailObj
。顯示
.To = "" '添加您自己的電子郵件
.CC =“”
.Subject = xSht.Name + " PDF for week ending " + xFileDate + " - Location " ' 主題包括工作表名稱、pdf、日期和位置，可根據需要進行編輯
.Attachments.Add x文件夾
.HTMLBody = xOutMsg & .HTMLBody
如果 DisplayEmail = False 那麼
'.Send <--- 這裡如果你刪除撇號，郵件會自動發送，所以請小心
如果結束
結束
其他
MsgBox "活動工作表不能為空"
退出小組
如果結束
END SUB
回复
即時報告
0
0
妮可
妮可
網站主持人對此評論進行了最小化
如何編輯此代碼以僅保存單元格（“a1：r99”）以另存為 PDF。 我的 PDF 文檔中有我不想要的額外內容。
子另存為pdfandsend()
'更新者 Extendoffice 20210209
將 xSht 調暗為工作表
將 xFileDlg 調暗為 FileDialog
將 xFolder 調暗為字符串
將 xYesorNo 調暗為整數
將 xOutlookObj 調暗為對象
將 xEmailObj 調暗為對象
將 xUsedRng 調暗為範圍
將 xStrName 調暗為字符串
將 xV 變暗為變體

設置 xSht = ActiveSheet
設置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那麼
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必須指定一個文件夾來保存 PDF。" & vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "必須指定目標文件夾"
退出小組
如果結束
xStrName = ""
xV = Application.InputBox("請輸入文件名:", "Kutools for Excel", , , , , , 2)
如果 xV = False 那麼
退出小組
如果結束
xStrName = xV
如果 xStrName = "" 那麼
MsgBox ("沒有輸入文件名，正在退出進程！")
退出小組
如果結束

xFolder = xFolder + "\" + xStrName + ".pdf"
'檢查文件是否已經存在
如果 Len(Dir(xFolder)) > 0 那麼
xYesorNo = MsgBox(xFolder & " 已經存在。" & vbCrLf & vbCrLf & "你想覆蓋它嗎？", _
vbYesNo + vbQuestion, "文件存在")
在錯誤恢復下一頁
如果 xYesorNo = vbYes 那麼
殺死 xFolder
其他
MsgBox "如果您不覆蓋現有的 PDF，我將無法繼續。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小組
如果結束
如果 Err.Number <> 0 則
MsgBox "無法刪除現有文件。請確保文件未打開或未寫保護。" _
& vbCrLf & vbCrLf & "按確定退出此宏。", vbCritical, "無法刪除文件"
退出小組
如果結束
如果結束

設置 xUsedRng = xSht.UsedRange
如果 Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 那麼
'另存為PDF文件
xSht.ExportAsFixedFormat 類型：=xlTypePDF，文件名：=xFolder，質量：=xlQualityStandard

'創建 Outlook 電子郵件
設置 xOutlookObj = CreateObject("Outlook.Application")
設置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。顯示
.To = ""
.CC =“”
.Subject = xSht.Name + ".pdf"
.Attachments.Add x文件夾
如果 DisplayEmail = False 那麼
'。發送
如果結束
結束
其他
MsgBox "活動工作表不能為空"
退出小組
如果結束
END SUB
回复
0
0
RLF
RLF     妮可
網站主持人對此評論進行了最小化
您好，我剛剛在我的一張工作表上嘗試了此代碼，並且我設置了打印區域，因此底部的額外內容沒有出現在 pdf 中。 嘗試一下！
回复
0
0
羅德·貝內特
羅德·貝內特
網站主持人對此評論進行了最小化
Hi
非常感謝代碼，但是是否可以將 PDF 自動保存到與活動 Excel 文件相同的位置，並且文件名與活動 Excel 文件相同？
非常感謝。
竿
回复
0
0
這裡還沒有評論
載入更多
留下你的意見
客人
以訪客身份發帖
登入
×
評價此帖子：
重設
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護