From Excel to PDF & send through Lotus Notes

ShvDK

Board Regular
Joined
Sep 5, 2003
Messages
92
Hi!

From MrExcel & PlanetPDF I have found some VBA-code that takes my print_area and uses the AcrobatDistiller to create a PDF-file and finally sends it with Lotus NOTes... but....

I tried to insert a msgbox at the beginning of the macro that ask the user if he is sure that he want to publish. My idea was that if he clicked on OK, the macro will perform - otherwise exit sub.

Quite simple I thought, but in one way or the other, the macro doesnt manage to attach the PDF-file to the Lotus NOTes that I send... and I really dont know why?

Could anybody (NateO ???) tell me whats wrong with my idea?

My code is as follows:

Code:
Sub Save_file_CreatePDF_Publish_PDF_with_LotusNotes

Dim PSFileName As String
Dim PDFFileName As String
Dim DistillerCall As String
Dim ReturnValue As Variant

Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim Session As Object
Dim EmbedObj As Object
Dim AttachME As Object

x = Application.ActivePrinter

Application.ActivePrinter = "Acrobat Distiller on Ne00:"

PSFileName = Range("filename_postscript").Value
PDFFileName = Range("filename_pdf").Value

    If Dir(PSFileName) <> "" Then Kill (PSFileName)
    If Dir(PDFFileName) <> "" Then Kill (PDFFileName)

SendKeys PSFileName & "{ENTER}", False
ActiveSheet.PrintOut , PrintToFile:=True

PSFileName = Chr(34) & PSFileName & Chr(34)
PDFFileName = Chr(34) & PDFFileName & Chr(34)

DistillerCall = "C:\Program Files\Adobe\Acrobat 4.0\Distillr\AcroDist.exe" _
& " /n /q /o" & PDFFileName & " " & PSFileName

ReturnValue = Shell(DistillerCall, vbNormalFocus)

    If ReturnValue = 0 Then MsgBox "Creation of " & PDFFileName & "failed."

PSFileName = Range("filename_postscript").Value
    If Dir(PSFileName) <> "" Then Kill (PSFileName)
    
Application.ActivePrinter = x    ’returns to the former ActivePrinter


Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, User-Name, " "))) & ".nsf"

Set Maildb = Session.GetDatabase("", MailDbName)

If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

Set MailDoc = Maildb.CREATEDOCUMENT

MailDoc.Form = "Memo"
MailDoc.sendto = Range("file_modtager").Value
MailDoc.Subject = Range("file_emne").Value
MailDoc.Body = "Denne mail er sendt direkte fra Excel...!!!!"

attachment1 = Range("filename_pdf").Value

If attachment1 <> "" Then
    On Error Resume Next
    Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
    Set EmbedObj = AttachME.embedobject(1454, "attachment1", _
    Range("filename_pdf").Value, "")
    On Error Resume Next
End If

MailDoc.Send 0, Recipient


Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:=Range("filename_excel").Value
Application.DisplayAlerts = True

Range("a1").Select

End Sub

All the best... ShvDk

Edit: NPO added code tags. :)
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

NateO

Legend
Joined
Feb 17, 2002
Messages
9,700
Hello! Hmmm, I missed the abort msgbox. The attachment issue was your use of Attachment1 instead of Attachment in the string description for the rich text item. How about the following:

<font face=Courier New><SPAN style="color:darkblue">Private</SPAN> <SPAN style="color:darkblue">Declare</SPAN> <SPAN style="color:darkblue">Function</SPAN> DeleteFile <SPAN style="color:darkblue">Lib</SPAN> "kernel32" Alias "DeleteFileA" _
    (<SPAN style="color:darkblue">ByVal</SPAN> lpFileName <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>) <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Long</SPAN>

<SPAN style="color:darkblue">Sub</SPAN> Save_file_CreatePDF_Publish_PDF_with_LotusNotes()

<SPAN style="color:darkblue">Dim</SPAN> PSFileName <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>, PDFFileName <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>, DistillerCall <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> ReturnValue <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Variant</SPAN>

<SPAN style="color:darkblue">Dim</SPAN> Maildb <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>, MailDoc <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>, Session <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>, EmbedObj <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> AttachMe <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> UserName <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>, MailDbName <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>

<SPAN style="color:darkblue">Dim</SPAN> x <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>

<SPAN style="color:darkblue">If</SPAN> MsgBox("Would you like to email the report?", vbYesNo) = vbNo _
    <SPAN style="color:darkblue">Then</SPAN> <SPAN style="color:darkblue">Exit</SPAN> <SPAN style="color:darkblue">Sub</SPAN>

x = Application.ActivePrinter

Application.ActivePrinter = "Acrobat Distiller on Ne00:"

PSFileName = Range("filename_postscript").Value
PDFFileName = Range("filename_pdf").Value

<SPAN style="color:darkblue">If</SPAN> <SPAN style="color:darkblue">CBool</SPAN>(Len(Dir(PSFileName))) <SPAN style="color:darkblue">Then</SPAN> <SPAN style="color:darkblue">Call</SPAN> DeleteFile(PSFileName)
<SPAN style="color:darkblue">If</SPAN> <SPAN style="color:darkblue">CBool</SPAN>(Len(Dir(PDFFileName))) <SPAN style="color:darkblue">Then</SPAN> <SPAN style="color:darkblue">Call</SPAN> DeleteFile(PDFFileName)

SendKeys PSFileName & "{ENTER}", <SPAN style="color:darkblue">False</SPAN>
ActiveSheet.PrintOut , PrintToFile:=<SPAN style="color:darkblue">True</SPAN>

PSFileName = ChrW$(34) & PSFileName & ChrW$(34)
PDFFileName = ChrW$(34) & PDFFileName & ChrW$(34)

DistillerCall = "C:\Program Files\Adobe\Acrobat 4.0\Distillr\AcroDist.exe" _
& " /n /q /o" & PDFFileName & " " & PSFileName

ReturnValue = Shell(DistillerCall, vbNormalFocus)

<SPAN style="color:darkblue">If</SPAN> <SPAN style="color:darkblue">Not</SPAN> <SPAN style="color:darkblue">CBool</SPAN>(ReturnValue) <SPAN style="color:darkblue">Then</SPAN>
    MsgBox "Creation of " & PDFFileName & "failed."
    <SPAN style="color:darkblue">Exit</SPAN> <SPAN style="color:darkblue">Sub</SPAN>
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">If</SPAN>

PSFileName = Range("filename_postscript").Value

<SPAN style="color:darkblue">If</SPAN> <SPAN style="color:darkblue">CBool</SPAN>(Len(Dir(PSFileName))) <SPAN style="color:darkblue">Then</SPAN> <SPAN style="color:darkblue">Call</SPAN> DeleteFile(PSFileName)
    
Application.ActivePrinter = x    <SPAN style="color:green">'returns to the former ActivePrinter</SPAN>

<SPAN style="color:darkblue">Set</SPAN> Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) _
    - InStr(1, User - Name, " "))) & ".nsf"

<SPAN style="color:darkblue">Set</SPAN> Maildb = Session.GetDatabase(vbNullString, MailDbName)

<SPAN style="color:darkblue">If</SPAN> <SPAN style="color:darkblue">Not</SPAN> Maildb.IsOpen <SPAN style="color:darkblue">Then</SPAN> Maildb.OpenMail

<SPAN style="color:darkblue">Set</SPAN> MailDoc = Maildb.CreateDocument

MailDoc.Form = "Memo"
MailDoc.sendto = Range("file_modtager").Value
MailDoc.Subject = Range("file_emne").Value
MailDoc.Body = "Denne mail er sendt direkte fra Excel...!!!!"

Attachment1 = Range("filename_pdf").Value

<SPAN style="color:darkblue">If</SPAN> <SPAN style="color:darkblue">CBool</SPAN>(Len(Attachment1)) <SPAN style="color:darkblue">Then</SPAN>
    <SPAN style="color:darkblue">On</SPAN> <SPAN style="color:darkblue">Error</SPAN> <SPAN style="color:darkblue">Resume</SPAN> <SPAN style="color:darkblue">Next</SPAN>
    <SPAN style="color:darkblue">Set</SPAN> AttachMe = MailDoc.CreateRichTextItem("Attachment")
    <SPAN style="color:darkblue">Set</SPAN> EmbedObj = AttachMe.EmbedObject(1454, _
        vbNullString, Attachment1, "Attachment")
    MailDoc.CreateRichTextItem ("Attachment")
    <SPAN style="color:darkblue">On</SPAN> <SPAN style="color:darkblue">Error</SPAN> <SPAN style="color:darkblue">GoTo</SPAN> 0
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">If</SPAN>

MailDoc.PostedDate = Now
<SPAN style="color:darkblue">Call</SPAN> MailDoc.Send(False)

Application.DisplayAlerts = <SPAN style="color:darkblue">False</SPAN>
ActiveWorkbook.SaveAs Filename:=Range("filename_excel").Value
Application.DisplayAlerts = <SPAN style="color:darkblue">True</SPAN>

Range("a1").<SPAN style="color:darkblue">Select</SPAN>

<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN></FONT>

As I don't have LN handy, I have not tested this.
 

ShvDK

Board Regular
Joined
Sep 5, 2003
Messages
92
Hi NateO... and thanks... This works great, but sometimes the attachment in LotusNOTes fails and the mail is send without the attachment.

Is there a way I can stop sending the mail if NOTes fails to insert the attachment. I can see it has been created but just not inserted everytime... Do U understand what I mean???

Second; what does the Private Decalare Function do???

ShvDk
 

NateO

Legend
Joined
Feb 17, 2002
Messages
9,700
Hello again,

The api call is a more robust way of removing the file.

Hmmm, could be that the code executes before the file is created. You could loop, something like:
Code:
Do while not CBool(Len(Dir(PSFileName)))
   doevents
loop
Before attempting the attachment. If you pull the error handler, do you get an error? Probably not eh, the if statement's kicking in... Might want to qualify the loop to trap an endless one, the concept being more for Excel to wait until the file is available.
 

ShvDK

Board Regular
Joined
Sep 5, 2003
Messages
92

ADVERTISEMENT

One down - two to go!
Now I understand the private declare function - thanks for that, but 2 problems remain.

First, this Do while - loop. Where should that be placed in order to loop before the attachment is ready to be inserted ???

Second, I start to have a "run time error" when the macro performs. In the error message, I'm told that either there isnt enough memory or there is a problem with network connection or the printer driver...

The funny thing is, that I have added some more parts to the sheet, but if I take the old version and runs the macro in that workbook, there isnt any problems at all.

The macro stops at:

SendKeys PSFileName & "{ENTER}", False
ActiveSheet.PrintOut , PrintToFile:=True

so to me it looks like the macro isnt able to insert the PSFileName in the "File to print" box more than a problem with the network / enough memory !?!

Thanks in advance !!!

ShvDk
 

ShvDK

Board Regular
Joined
Sep 5, 2003
Messages
92
... Could this have something to do with the fact that I now have inserted a chart more in the print area and the data to the chart is volatilie ???

ShvDk
 

NateO

Legend
Joined
Feb 17, 2002
Messages
9,700

ADVERTISEMENT

Hello,

You'll want to loop just before you create the attachment in the original:

If CBool(Len(Attachment1)) Then

As for the network/memory issue, I couldn't tell you, sorry.
 

ShvDK

Board Regular
Joined
Sep 5, 2003
Messages
92
Hi NateO,

Both problems solved - I'll manage to create the loop and it works! Regarding the network/enough memory problem I did a minor workaround, where I simply copy/pasted value of the filename in order to change it to nonvolatile. After that I havent had any problems!

Once again - Thanks !!!
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,322
Messages
5,769,448
Members
425,547
Latest member
Iano

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top