WORD PDF EMAIL VBA

[jakub1241996]

Hello please help not working PDF

Sub PDF_SAVE()
Application.ScreenUpdating = False
Dim PatientName As String, Dt As String

myFolderName = Environ("userprofile") & "\SPMO\Reklamace - Reklamace\"
Dim strFileName As String
Dim objOutlook As Object
Dim objMailItem As Object


With ActiveDocument
strFileName = Replace(ActiveDocument.FullName, ".docm", ".pdf")
Dl = " " & Trim(Split(Split(.Range.Text, "Dodací list:")(1), vbCr)(0))
Shipment = " " & Trim(Split(Split(.Range.Text, "Shipment (ASTRO WMS):")(1), vbCr)(0))
RP = "__RP"
ActiveDocument.SaveAs2 myFolderName & RP & Dl & Shipment & ".pdf", FileFormat:=wdFormatText, AddToRecentFiles:=False
ActiveDocument.ExportAsFixedFormat OutputFileName:=strFileName, _
ExportFormat:=wdExportFormatPDF

Set objOutlook = CreateObject("Outlook.Application")
Set objMailItem = objOutlook.CreateItem(0) ' 0 = olMailItem
With objMailItem
.Subject = "& RP & Dl &"
.Body = "My Message"
.To = "jakub@sp.cz"
.Attachments.Add strFileName
.Display
End With

Kill strFileName

Set objMailItem = Nothing
Set objOutlook = Nothing
End With
Dim bExists As Boolean
Dim MyPrint As Dialog

' ensure our doc variable exists
bExists = False
For Each varItem In ActiveDocument.CustomDocumentProperties
If varItem.Name = "Copies" Then
bExists = True
Exit For
End If
Next varItem

' initialize document variable if doesn't exist
If Not bExists Then
ActiveDocument.CustomDocumentProperties.Add _
Name:="Copies", LinkToContent:=False, _
Type:=msoPropertyTypeNumber, Value:=1
End If

Set MyPrint = Dialogs(wdDialogFilePrint)
With MyPrint
.NumCopies = ActiveDocument.CustomDocumentProperties("Copies")
.Show
End With

ActiveDocument.CustomDocumentProperties("Copies") = _
MyPrint.NumCopies


Dim windowsObject As Object


Application.ScreenUpdating = False

End Sub

 

[jakub1241996]

Evening all,

i've nearly cracked this but i'm stuck on the last bit. I need it to send the saved pdf, not the open word doc, any ideas?

Sub PDF_SAVE()
Application.ScreenUpdating = False
Dim PatientName As String, Dt As String

myFolderName = Environ("userprofile") & "\SPMO\Reklamace - Reklamace\"
Dim strFileName As String
Dim objOutlook As Object
Dim objMailItem As Object


With ActiveDocument
strFileName = Replace(ActiveDocument.FullName, ".docm", ".pdf")
Dl = " " & Trim(Split(Split(.Range.Text, "Dodací list:")(1), vbCr)(0))
Shipment = " " & Trim(Split(Split(.Range.Text, "Shipment (ASTRO WMS):")(1), vbCr)(0))
RP = "__RP"
ActiveDocument.SaveAs2 myFolderName & RP & Dl & Shipment & ".pdf", FileFormat:=wdFormatText, AddToRecentFiles:=False
ActiveDocument.ExportAsFixedFormat OutputFileName:=strFileName, _
ExportFormat:=wdExportFormatPDF

Set objOutlook = CreateObject("Outlook.Application")
Set objMailItem = objOutlook.CreateItem(0) ' 0 = olMailItem
With objMailItem
.Subject = "& RP & Dl &"
.Body = "My Message"
.To = "[EMAIL]jakub@sp.cz[/EMAIL]"
.Attachments.Add strFileName
.Display
End With

Kill strFileName

Set objMailItem = Nothing
Set objOutlook = Nothing
End With
Dim bExists As Boolean
Dim MyPrint As Dialog

' ensure our doc variable exists
bExists = False
For Each varItem In ActiveDocument.CustomDocumentProperties
If varItem.Name = "Copies" Then
bExists = True
Exit For
End If
Next varItem

' initialize document variable if doesn't exist
If Not bExists Then
ActiveDocument.CustomDocumentProperties.Add _
Name:="Copies", LinkToContent:=False, _
Type:=msoPropertyTypeNumber, Value:=1
End If

Set MyPrint = Dialogs(wdDialogFilePrint)
With MyPrint
.NumCopies = ActiveDocument.CustomDocumentProperties("Copies")
.Show
End With

ActiveDocument.CustomDocumentProperties("Copies") = _
MyPrint.NumCopies


Dim windowsObject As Object


Application.ScreenUpdating = False

End Sub

[URL='https://www.mrexcel.com/board/threads/word-pdf-email-vba.1227675/reply?quote=6006669']Quote[/URL] [URL='https://www.mrexcel.com/board/threads/word-pdf-email-vba.1227675/reply?quote=6006669']Reply[/URL]
[URL='https://www.mrexcel.com/board/posts/6006669/report']Report[/URL]