PDA

View Full Version : Email completed PDF



ref4ua
2012-01-21, 05:23 PM
Ken,
I'm working on a project to print selected worksheets to a pdf and then email it out automatically. I'm having issue with the code and thought that this might help, but it kept giving me an error. I need the code to send the pdf as soon as it is published. Maybe you can look at the code and give me some pointers. I think you may have worked on this in the past.


' Print Multiple Worksheets to a Single PDF File:



Sub PrintToPDF_MultiSheetToOne_Early()

Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Dim lTtlSheets As Long

'/// Change the output file name here! ///
sPDFName = "Consolidated.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
Set pdfjob = New PDFCreator.clsPDFCreator

'Make sure the PDF printer can start
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "Error!"
Exit Sub
End If

'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

'Print the document to PDF
' lTtlSheets = Application.Sheets.Count
'For lSheet = 1 To Application.Sheets.Count
' On Error Resume Next 'To deal with chart sheets
' If Not IsEmpty(Application.Sheets(lSheet).UsedRange) Then
' Application.Sheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Else
' lTtlSheets = lTtlSheets - 1
'End If
' On Error GoTo 0
' Next lSheet


'Print the document to PDF
lTtlSheets = frmPrinttoPDF.lstProcess.ListCount - 1
For lSheet = 0 To frmPrinttoPDF.lstProcess.ListCount - 1
On Error Resume Next 'To deal with chart sheets
If Not IsEmpty(Application.Sheets(frmPrinttoPDF.lstProcess.List(lSheet)).UsedRange) Then
If Not frmPrinttoPDF.CheckBox1.Value = True Then pdfjob.cOption("AutosaveFilename") = sPDFName & "Sheetname" ' This should be the worksheet name
Application.Sheets(frmPrinttoPDF.lstProcess.List(lSheet)).PrintOut copies:=1, ActivePrinter:="PDFCreator"
Else
lTtlSheets = lTtlSheets - 1
End If
On Error GoTo 0
Next lSheet

'Wait until all print jobs have entered the print queue
Do Until pdfjob.cCountOfPrintjobs = lTtlSheets
DoEvents
Loop

'Combine all PDFs into a single file and stop the printer
' With pdfjob
' .cCombineAll
' .cPrinterStop = False
'End With

With pdfjob
If frmPrinttoPDF.CheckBox1.Value = True Then .cCombineAll
.cPrinterStop = False
End With

'Wait until the PDF file shows up then release the objects
Do Until Dir(sPDFPath & sPDFName) <> ""
DoEvents
Loop
'Send PDF as Email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "test@test.com"
.CC = ""
.BCC = ""
.Subject = "Test"
.Body = "YYY"
.Attachments.Add sPDFPath & sPDFName
.Send 'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
MsgBox ("The PDF has been successfully created as " & sPDFName)
pdfjob.cClose
Sleep 1000
Set pdfjob = Nothing
End Sub

Ken Puls
2012-01-23, 04:19 AM
Hi ref4ua, and welcome to the forum.

I've split your question into a new thread. Although related to this one (http://www.excelguru.ca/forums/showthread.php?617-Looking-for-testers), I think it would be better suited on it's own. :)

One thing you may want to do is to have a look at the most recent version of the PDF article (http://www.excelguru.ca/content.php?161-Printing-Worksheets-To-A-PDF-File-(Using-Early-Binding)). It's got a new method for opening that will kill off any open instance of PDFCreator.

With regards to the issue at hand, you didn't say what the error actually was... I'm assuming it's in the attempt to send the email?Can you tell me what the error text is, and what line is highlighted when you click Debug?As a stab, you could try the following:

Download and unzip the attached file.
Go into the VBE, find your project, right click it and choose "Import"
Locate the download file and select it.
This should import the class module referenced in the previous thread to make it easy to add Email functionality.

Next, replace this:

'Send PDF as Email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next

With OutMail
.To = "test@test.com"
.CC = ""
.BCC = ""
.Subject = "Test"
.Body = "YYY"
.Attachments.Add sPDFPath & sPDFName
.Send 'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
MsgBox ("The PDF has been successfully created as " & sPDFName)
pdfjob.cClose
Sleep 1000
Set pdfjob = Nothing

With this:

'Create the email object
Dim oEmail As New clsOutlookEmail
With oEmail
'Add a recipient
.AddToRecipient = "test@test.com"

'Set the subject
.Subject = "Test"

'Set the body
.Body = "YYY"

'Add a couple of attachments
.AttachFile = sPDFPath & sPDFName

'Preview the email (or use .Send to send it)
.Preview
End With

'Release objects and terminate PDFCreator
On Error Resume Next
Set pdfjob = Nothing
Set oEmail = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
Application.ScreenUpdating = True

Let me know if that helps...

ref4ua
2012-01-23, 05:00 AM
Ken,
Thanks for the help. I changed the code as you suggested and imported the class module as well. I can print the selected sheets to a pdf, but does not send the email. I looked in my outlook and it doesn't show it in the sent or outbox folders. Any suggestions?

Randall

Ken Puls
2012-01-23, 05:09 AM
Hi Randall,

Are you seeing any errors with the new version at all?

What version of Office are you using?

ref4ua
2012-01-23, 05:13 AM
Ken,
I'm not seeing any errors. I have a userform set up to select the pages you want to print. It will print the pdf and place it in the required folder, but will not send the email. I'm using Office 2010.

Ken Puls
2012-01-23, 05:17 AM
Strange...

Try this for a second... create a new module in the same file, and drop in the following code:

Public Sub EmailViaOutlook()
'Create the email object
Dim oEmail As New clsOutlookEmail
With oEmail
'Add a recipient
.AddToRecipient = "test@test.com"
'Set the subject
.Subject = "Test"
'Set the body
.Body = "YYY"
'Preview the email (or use .Send to send it)
.Preview
End With

End Sub

Does it create an email at all?

If not, can you create a new file, import the class module, and then try the code I posted here again?

I'm just trying to figure out if it's the code or if there is something in the file messing us up here. (I'm using Office 2010 as well.)

ref4ua
2012-01-23, 05:27 AM
Ken,
When I added the code you just sent it worked great. I'm going to send you all the code for the module I'm using and also the user form.

Here is the user form:


Option Explicit
Option Base 0


Private Sub CmdBrowse_Click()

Dim objShell As Object
Dim objFolder As Object
Dim strFolderFullPath As String

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Please select a folder", 0, "C:\MyFolders\TestFolder")

If (Not objFolder Is Nothing) Then

On Error Resume Next
If IsError(objFolder.Items.Item.Path) Then strFolderFullPath = CStr(objFolder): GoTo Here
On Error GoTo 0

If Len(objFolder.Items.Item.Path) > 3 Then
strFolderFullPath = objFolder.Items.Item.Path & Application.PathSeparator
Else
strFolderFullPath = objFolder.Items.Item.Path
End If
Else
MsgBox "User cancelled": End
End If

Here:
'Loads Textbox1 with drive
TextBox1.Value = strFolderFullPath

End Sub


Private Sub CheckBox2_Click()

End Sub

Private Sub CheckBox3_Click()

End Sub

Private Sub cmdAdd_Click()
Dim i As Integer

With Me.lstAvailable
For i = .ListCount - 1 To 0 Step -1
If .Selected(i) Then
Me.lstProcess.AddItem .List(i)
.RemoveItem i
End If
Next i
End With
End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdRemove_Click()
Dim i As Integer

With Me.lstProcess
For i = .ListCount - 1 To 0 Step -1
If .Selected(i) Then
Me.lstAvailable.AddItem .List(i)
.RemoveItem i
End If
Next i
End With
End Sub

Private Sub cmdStart_Click()
Dim i As Integer

With Me.lstProcess
If .ListCount = 0 Then
MsgBox "At least one sheet has to be selected for processing.", vbExclamation
Else

Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Dim lTtlSheets As Long, jobcount As Integer


'/// Change the output file name here! ///
If frmPrinttoPDF.TextBox2.Value <> "" Then
sPDFName = frmPrinttoPDF.TextBox2.Value
Else
sPDFName = "Consolidated"
End If
sPDFPath = TextBox1.Value & "\"
Set pdfjob = New PDFCreator.clsPDFCreator

'Make sure the PDF printer can start
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "Error!"
Exit Sub
End If

'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName & ".pdf"
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

'Print the document to PDF
lTtlSheets = lstProcess.ListCount
jobcount = 0
For lSheet = 0 To lstProcess.ListCount - 1
' On Error Resume Next 'To deal with chart sheets
If Not IsEmpty(Application.Sheets(lstProcess.List(lSheet)).UsedRange) Then

If Not CheckBox1.Value = True Then
' set name, print and close, for each single pdf
' pdfjob.cOption("AutosaveFilename") = sPDFName & lstProcess.List(lSheet) & ".pdf"
pdfjob.cOption("AutosaveFilename") = lstProcess.List(lSheet) & ".pdf"
If Len(Dir(sPDFPath & pdfjob.cOption("AutosaveFilename"))) > 0 Then Kill sPDFPath & pdfjob.cOption("AutosaveFilename")
Application.Sheets(lstProcess.List(lSheet)).PrintOut copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until Len(Dir(sPDFPath & pdfjob.cOption("AutosaveFilename"))) > 0
DoEvents
Loop
Else
If Len(Dir(sPDFPath & pdfjob.cOption("AutosaveFilename"))) > 0 Then Kill sPDFPath & pdfjob.cOption("AutosaveFilename")
Application.Sheets(lstProcess.List(lSheet)).PrintOut copies:=1, ActivePrinter:="PDFCreator"
jobcount = jobcount + 1
Do Until pdfjob.cCountOfPrintjobs = jobcount
DoEvents
Loop
End If
Else
lTtlSheets = lTtlSheets - 1
End If
Next
' close document for combined pdf
With pdfjob
If CheckBox1.Value = True Then
Do Until pdfjob.cCountOfPrintjobs = lTtlSheets
DoEvents
Loop
' If Len(Dir(sPDFPath & pdfjob.cOption("AutosaveFilename"))) > 0 Then Kill sPDFPath & pdfjob.cOption("AutosaveFilename")
.cCombineAll
.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
Do Until Len(Dir(sPDFPath & pdfjob.cOption("AutosaveFilename"))) > 0
DoEvents
Loop
End If
Sleep 250
pdfjob.cOption("UseAutosave") = 0
.cClose
End With
Set pdfjob = Nothing
Unload Me
End If
End With

End Sub


Private Sub MoveDown_Click()
Dim ItemNum As Long, TempItem
With Me.lstProcess
If .ListIndex = .ListCount - 1 Then Exit Sub
ItemNum = .ListIndex
TempItem = .List(ItemNum)
.List(ItemNum) = .List(ItemNum + 1)
.List(ItemNum + 1) = TempItem
.ListIndex = ItemNum + 1
End With
End Sub

Private Sub MoveDown_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call MoveDown_Click

End Sub


Private Sub MoveUp_Click()
Dim ItemNum As Long, TempItem
With Me.lstProcess
If .ListIndex <= 0 Then Exit Sub
ItemNum = .ListIndex
TempItem = .List(ItemNum)
.List(ItemNum) = .List(ItemNum - 1)
.List(ItemNum - 1) = TempItem
.ListIndex = ItemNum - 1
End With
End Sub

Private Sub MoveUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call MoveUp_Click

End Sub

Private Sub UserForm_Initialize()
TextBox1.Value = "C:\Users\REF4UA\Desktop\test pdf"


Dim actualSheet As Worksheet


For Each actualSheet In Application.ActiveWorkbook.Sheets
If actualSheet.Visible = True Then
With actualSheet

Me.lstAvailable.AddItem .Name

End With
End If
Next actualSheet



End Sub

ref4ua
2012-01-23, 05:33 AM
Thanks again for all your help!

ref4ua
2012-01-23, 05:33 AM
Here is the code to print to pdf:


'Set Reference to PDFCreator
' Print a Single Worksheet to a PDF File:
Option Explicit

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub PrintToPDF_Early()


Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String

'/// Change the output file name here! ///
sPDFName = "testPDF.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator

'Check if worksheet is empty and exit if so
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub

Set pdfjob = New PDFCreator.clsPDFCreator

With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

'Print the document to PDF
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
End Sub

' Print Multiple Worksheets to Multiple PDF Files:



Sub PrintToPDF_MultiSheet_Early()


Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long

Set pdfjob = New PDFCreator.clsPDFCreator
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator

If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If

For lSheet = 1 To ActiveWorkbook.Sheets.Count
'Check if worksheet is empty and skip if so
If Not IsEmpty(ActiveSheet.UsedRange) Then
With pdfjob
'/// Change the output file name here! ///
sPDFName = "testPDF" & Sheets(lSheet).Name & ".pdf"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

'Print the document to PDF
Worksheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"

'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
End If
Next lSheet
pdfjob.cClose
Set pdfjob = Nothing
End Sub

Option Explicit
Option Explicit
Sub PrintToPDF_MultiSheetToOne_Early()
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for early bind, set reference to PDFCreator

Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Dim lTtlSheets As Long
Dim bRestart As Boolean

'/// Change the output file name here! ///
sPDFName = "Consolidated.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator

'Activate error handling and turn off screen updates
On Error GoTo EarlyExit
Application.ScreenUpdating = False
Set pdfjob = New PDFCreator.clsPDFCreator

'Check if PDFCreator is already running and attempt to kill the process if so
Do
bRestart = False
Set pdfjob = New PDFCreator.clsPDFCreator
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
'PDF Creator is already running. Kill the existing process
Shell "taskkill /f /im PDFCreator.exe", vbHide
DoEvents
Set pdfjob = Nothing
bRestart = True
End If
Loop Until bRestart = False

'Assign settings for PDF job
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

'Delete the PDF if it already exists
If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName)

'Print the document to PDF
lTtlSheets = Application.Sheets.Count
For lSheet = 1 To Application.Sheets.Count
On Error Resume Next 'To deal with chart sheets
If Not IsEmpty(Application.Sheets(lSheet).UsedRange) Then
Application.Sheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
Else
lTtlSheets = lTtlSheets - 1
End If
On Error GoTo EarlyExit
Next lSheet

'Wait until all print jobs have entered the print queue
Do Until pdfjob.cCountOfPrintjobs = lTtlSheets
DoEvents
Loop

'Combine all PDFs into a single file and stop the printer
With pdfjob
.cCombineAll
.cPrinterStop = False
End With

'Wait until the file shows up before closing PDF Creator
Do
DoEvents
Loop Until Dir(sPDFPath & sPDFName) = sPDFName

Cleanup:
'Release objects and terminate PDFCreator
Set pdfjob = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub

EarlyExit:
'Inform user of error, and go to cleanup section
MsgBox "There was an error encountered. PDFCreator has" & vbCrLf & _
"has been terminated. Please try again.", _
vbCritical + vbOKOnly, "Error"
Resume Cleanup
'Create the email object
Dim oEmail As New clsOutlookEmail
With oEmail
'Add a recipient
.AddToRecipient = "myemail@work.com"

'Set the subject
.Subject = "Test"

'Set the body
.Body = "YYY"

'Add a couple of attachments
.AttachFile = sPDFPath & sPDFName

'Preview the email (or use .Send to send it)
.Preview
End With

'Release objects and terminate PDFCreator
On Error Resume Next
Set pdfjob = Nothing
Set oEmail = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Ken Puls
2012-01-23, 05:50 AM
Aha!

So the issue is that you put the last code in the EarlyExit section... which only fires if you have an error. Since there is no error in the PDF creation part (a good thing), the email isn't firing. :)

Easy to fix. Replace everything from in that last routine from Cleanup down with:



'Create the email object
Dim oEmail As New clsOutlookEmail
With oEmail
'Add a recipient
.AddToRecipient = "myemail@work.com"

'Set the subject
.Subject = "Test"

'Set the body
.Body = "YYY"

'Add a couple of attachments
.AttachFile = sPDFPath & sPDFName

'Preview the email (or use .Send to send it)
.Preview
End With

Cleanup:
'Release objects and terminate PDFCreator
On Error Resume Next
Set pdfjob = Nothing
Set oEmail = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub

EarlyExit:
'Inform user of error, and go to cleanup section
MsgBox "There was an error encountered. PDFCreator has" & vbCrLf & _
"has been terminated. Please try again.", _
vbCritical + vbOKOnly, "Error"
Resume Cleanup

ref4ua
2012-01-23, 05:51 AM
Ken,
Here is the complete file I'm working with. If you look under Add-ins on the tool bar you will see the option to print to pdf. This will open up the user form.

Randall

Ken Puls
2012-01-23, 06:00 AM
Give this a go and let me know if it works. :)

ref4ua
2012-01-23, 06:03 AM
Ken,
I changed the code to send the email before the early exit, but it will not open the preview for outlook. It has not given any errors either. Here is the workbook I'm using.

Thanks again!
Randall
433

ref4ua
2012-01-23, 06:09 AM
I tried the file you sent and it still will not open outlook for preview.......:Cry:

Ken Puls
2012-01-23, 06:16 AM
Hi Randall,

I'm curious... did you start this project or are you maintaining it? Don't take offense, but I'm just trying to get a gauge on your coding level here.

I assumed that you were calling the PrintToPDF routine I was coding, but I just stepped through your userform and it's not... which means that you've got a bigger issue here as the userform routine needs to be adjusted...

To do it correctly, I think we should talk about your logic a bit and make sure we do it correctly. :)

First thing though... how much code have you written, and how are your debugging skills? Do you know how to set breakpoints and step through code?

ref4ua
2012-01-23, 06:21 AM
Ken,
To be honest, I'm a beginner at coding, "I know enough to mess it up". This is a project for work. I was searching the web and came across the code that you had written and then found where another coder had built the userform for it.

Basically, I need a system for our guys in the field to work in excel select the sheets they need to print to a pdf and have that pdf automatically sent via email to an address. I thought a userform would best suit this situation, since it gave them the option to select the sheets they need, it changes depending on the job.

How bad is it messed up?

Randall

Ken Puls
2012-01-23, 07:06 AM
It's bad, Randall... real bad...

No, I'm just kidding. The calls were a based on a very old version of the code I had, and it's been hacked apart pretty bad. Beyond that, the biggest thing I saw was that you didn't know where to put the code.

I've fixed it up for you. You can delete Module3, as you don't need it.

If you're going to do any amount of coding, I HIGHLY recommend that you learn some debugging skills, and fast. You need to know the following:

Setting/clearing Breakpoints
Stepping through code
Setting watches
It would also be a good idea to learn about the locals and immediate windows.

VBA is a huge field, and awesomly powerful, but you need some base knowledge to really get a good grasp and move forward. I'm happy to help you with that, if you like. :)

Test this out, and let me know,

ref4ua
2012-01-23, 07:19 AM
:clap2:
Ken,
Thank you so much!!!!! It works great. Now for a stupid question. Since we deleted module 3 where do I edit the email address?

I would love to learn more as it would make my job a lot easier. Plus it's just "cool". Any info your willing so share I'm willing to learn.

I will be in Vancouver for work in March. I owe you the biggest steak you want!!

Thanks again
Randall

ref4ua
2012-01-23, 07:21 AM
found the email in the userform

Ken Puls
2012-01-23, 07:27 AM
LOL!

You may want to code something for your UserForm_Initialize event to get the correct location to the user's desktop folder to show up when the userform opens too. That messed me up for a bit. :)

ref4ua
2012-01-23, 07:33 AM
I just emailed myself a pdf with the code. When I received it it showed it as a pdf but tried to open in notepad. Any thoughts? It would not recognize it when I tried to open with Adobe.

Ken Puls
2012-01-23, 07:39 AM
Hmmm... no... that's weird...

What version of PDFCreator are you using? I'll test here as well.

ref4ua
2012-01-23, 07:42 AM
I'm using v1.2.3. It stores the file in the folder as a pdf that can be opened. When it emails it out is when it is having issue.

Ken Puls
2012-01-23, 07:46 AM
I'm seeing that here too... that is really weird. If the file is created fine, it should attach fine... I wonder what is going on here...

I may not be able to get you an answer on this one tonight, Randall. It's almost 11pm my time, and I've got to work in the morning. I'lll try a few tests on my side and get back to you though.

ref4ua
2012-01-23, 07:48 AM
I understand Ken. Thanks again! This forum is a huge resource.

Ken Puls
2012-01-23, 07:57 AM
Got it.

So as it turns out, we test if the file shows up in Windows Explorer. What I didn't realize is that the code runs so fast that the file shows up, but the details aren't completely written to it before it gets uploaded to the outlook email. So basically you have a process that looks like this:

Routine triggers write
File created
Writing starts
File uploaded to outlook
Writing finishes
This explains why the file on the desktop opened... it was complete. But the outlook one was uploaded too quickly.

I've inserted a 1 second pause in the code to fix that issue. (It's the Application.Wait line). If you're still getting the error, try changing that to a 2 or 3 second delay instead.

Let me know if that fixes it up for you. :)

ref4ua
2012-01-23, 08:17 AM
I had to expand the time window to 3 seconds. Is there anyway to keep selected sheets from coming up in the userform as an option to print?

Ken Puls
2012-01-24, 03:47 AM
Of course!

Change the Userform's Initialize event to this:


Private Sub UserForm_Initialize()
TextBox1.Value = "C:\Users\" & Environ("Username") & "\Desktop\test pdf"
Dim ws As Worksheet
For Each ws In Application.ActiveWorkbook.Sheets
With ws
If .Visible = False Then
'Sheet not visible, so ignore it
Else
'Choose which sheets to ignore
Select Case .Name
Case Is = "HideMe", "DontShow" '<-- list the sheets you want to ignore
'Don't want to show the above, so ignore them
Case Else
Me.lstAvailable.AddItem .Name
End Select
End If
End With
Next ws
End Sub

You'd need to change the "HideMe", "DontShow" to the names of the worksheets you want to hide.

I also changed the code so that it defaults to the active user's desktop folder, rather than the hard coded one.

With regards to the pause, I'd increase it to 4 seconds, just to be safe. If you have something else running, it could slow down the process and trigger the error again, so best add the second for insurance. :)

ref4ua
2012-01-24, 07:25 PM
Ken,
Thanks again that was exactly what I was needing! One final question, do you have any code that will allow you the option to print from the userform to your default printer. Our guys in the field have to print a paper copy for the customer and they will do the PDF for our own storage. If there is a way to add an additional command button to the user form that they can click that will send the selected sheets to the default printer, but not close out the userform so they can send the same sheets to the pdf/email command. This would make it a one stop shop for what we need.

Randall

Ken Puls
2012-01-27, 05:41 AM
Hi Randall,

Try this. I did make a change to the userform to accomodate this, and moved/renamed the code for the buttons to make it clearer on the back end a bit. So if you're copying this to your own project, I'd recommend deleting your userform, and copying this one into your file.

Hope it helps,

ref4ua
2012-02-22, 03:27 PM
Ken,
I'm needing to change the way this workbook emails out. Prior I was using Outlook, but I'm noticing that the email is sitting in the outbox for an extended period of time. I have it set to auto send/receive. I've thought about using smtp instead for instant sending. Our company runs on and exchange server. I've found some code that is supposed to send via smtp, but have some quesitons. Is it as simple as replacing the existing code in the userform or does further change need to take place, also since we have so many users of this workbook, is there a way to automatically have the code fill in the username and password for their exchange email account?

Here is the code I've found, does it look like it will work for what I need?



Public Function Mail_SMTP(strNTUserName As String, strNTUserPwd As String, _
strFrom As String, strTo As String, Optional strSubject As String, _
Optional strBody As String, Optional strBCC As String, _
Optional strCC As String, Optional strAttachment As String, _
Optional strHTMLBody As String, Optional strMailServer As String = "10.2.0.32")
On Error GoTo ErrHandler
Dim email As New CDO.Message
With email
.From = strFrom
.To = strTo
If (Len(strAttachment) > 0) Then .AddAttachment strAttachment
If (Len(strHTMLBody) > 0) Then .HTMLBody = strHTMLBody '"<H4>See attached file</H4>"
If (Len(strBCC) > 0) Then .BCC = strBCC
If (Len(strCC) > 0) Then .CC = strCC
If (Len(strSubject) > 0) Then .Subject = strSubject
If (Len(strBody) > 0) Then .TextBody = strBody
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/authenticate") = 0
'Your UserID on the SMTP server
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strNTUserName
'Your password on the SMTP server
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strNTUserPwd
'Server port (typically 25)
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Use SSL for the connection (False or True)
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Configuration.Fields.Update
.Send
End With
ExitProcedure:
Exit Function
ErrHandler:
Err.Raise Err.Number, "Mail_SMTP", "An the following error occurred while attempting " & _
"to send mail via Mail_SMTP." & vbCrLf & "Error Number: " & Err.Number & _
vbCrLf & vbCrLf & "Error Description: " & vbCrLf & Err.Description
Resume ExitProcedure
End Function




Thanks again!

Ken Puls
2012-02-24, 07:26 AM
Hey, sorry for the late reply. Things have been busy.

How about this... how about we modify the class module so that it triggers a SendAndReceive in Outlook?

To do this, go into the class module, and replace the Public Sub Send() routine with this one:


Public Sub Send()
'Method to preview the email
Dim objOL As Object
Dim objMail As Object
Dim olNS As Object

'Bind to Outlook
Set objOL = CreateObject("Outlook.Application")
Set olNS = objOL.GetNamespace("MAPI")
olNS.logon

'Create a new email
Set objMail = objOL.CreateItem(0)
CreateMessage objMail

'Preview the message
objMail.Send
olNS.SendAndReceive (False)
olNS.logoff

'Release all objects
Set objMail = Nothing
Set objOL = Nothing
End Sub

kmnexcel
2013-09-14, 12:19 PM
Error showing -> Dim oEmail As New clsOutlookEmail -> Compile Error: User-defined type not defined