excel - 如何使用 Excel VBA 将当前工作表保存为 PDF 和 Outlook 电子邮件?
问题描述
我的任务是查找或创建一个新的宏模块,该模块仅将当前工作表保存为 PDF 格式(保存到临时文件夹)。
我所能找到的与我想做的很接近的就是我所附的东西。这会提示用户输入保存位置。
如何将其更改为,不提示保存位置,保存到临时文件夹,然后通过 Outlook 将 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
解决方案
总之,您在附加的代码中拥有所需的一切:
删除这是选择目的地的提示。
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 = C:\fullpath\filename.pdf
虽然我建议:
xFolder = ThisWorkbook.Sheets("Setup").Range("A1") 'something in those lines, you could name sheet to be safer.
留下检查文件是否存在的部分,它可能会变得很方便,因为有时如果您使用共享驱动器,它们可能会被其他人阻止并且kill
功能将不起作用。
休息应该没问题。
推荐阅读
- javascript - 比较两个数组并合并不重复
- bootstrap-4 - Angular 中的 Boostrap 4 Navbar Dropdown 不适用于小型设备
- python - 如何将新列作为字符串分配给 Pandas Assign
- flutter - 类型“int”是否不是“double”类型的子类型
- mysql - 如何使用另一个表中的值更新特定列
- javascript - 当模型和模式存储在另一个文件中时,如何使用 findOne() 或 find() 等方法从 Node js 中的 MongoDB 检索文档?
- java - OjAlgo 特征值是否总是按降序排列?
- java - 我应该使用 2 路聚合还是有更好的解决方案?
- c++ - 如何并行执行 BIG RGB 图像的 jpeg 编码?
- sql - AnyLogic:由速率和匹配变量定义的到达