PDA

View Full Version : Strange delay in execution of MailTo Macro code



tnuis
09-27-2013, 09:00 AM
Hello, The following code takes ages to run. It gets quickly to the point where it opens a New EMPTY email and then the users have to wait for about 4-5 minutes before the rest of the code finally executes. Anybody have any tips as how to speed things up? It would be much appreciated. It seems to me that it is getting stuck at the point "'*****save as pdf ". Almost as if the Publishing of the pdf´s takes a loooong time to start. And, all users use Office 2010.
Sub Mailto_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String
Dim FullPath As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

If Sheet1.Visible = xlSheetVisible Then
Sheet1.Visible = xlSheetHidden
End If
If Sheet2.Visible = xlSheetVisible Then
Sheet2.Visible = xlSheetHidden
End If
If Sheet5.Visible = xlSheetVisible Then
Sheet5.Visible = xlSheetHidden
End If
If Ark6.Visible = xlSheetVisible Then
Ark6.Visible = xlSheetHidden
End If
With OutMail
.Display
End With
Signature = OutMail.htmlbody
Dim ws As Worksheet
'*****save as pdf
For Each ws In Sheets
If ws.Visible = True Then
FullPath = ThisWorkbook.Path & "\" & ws.Name & ".PDF"

ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=FullPath
End If
Next
'********
On Error Resume Next
With OutMail
.To = Range("D10").Value
.CC = ""
.BCC = ""
.Subject = "Papirer Bestilling"
.htmlbody = "Sampletext" & Signature
'****add as attachements
For Each ws In Sheets
If ws.Visible = True Then
FullPath = ThisWorkbook.Path & "\" & ws.Name & ".PDF"
.Attachments.Add FullPath
End If
Next
Sheet1.Visible = xlSheetVisible
If Sheet1.ComboBox3.Value = "Leie" Then
Ark6.Visible = xlSheetVisible
Sheet5.Visible = xlSheetVisible
End If
If Sheet1.ComboBox3.Value = "Leasing" Then
Ark6.Visible = xlSheetVisible
Sheet5.Visible = xlSheetVisible
End If

Sheet1.Activate
'********
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing


End Sub

Kenneth Hobs
09-27-2013, 09:14 AM
If you had Outlook open already, and used GetObject() rather than CreateObject() that might speed things. DoEvents may help on occassion. http://answers.microsoft.com/en-us/office/forum/office_2010-customize/getobject-fails-with-outlook-2010/1ee65231-2118-4223-8c40-95a9680000f8

Creation of the PDFs may be taking longer than you think. Try using a timer to see time for tasks.

From a blank sheet run

Sub FillARange()
Dim r As Range, bRange As Range, t1 As Double
Cells.ClearContents
t1 = Timer
SpeedOn
[A1] = "ColA"
[B1] = "ColB"
[C1] = "ColC"
Set bRange = Range("A2:C1000")
For Each r In bRange
If r.Column = 1 And r.Row Mod 2 = 0 Then
r.Value = "Delete"
Else: r.formula = "=Row()*Column()"
End If
Next r
SpeedOff
MsgBox "Added " & bRange.Rows.Count & " rows and " & bRange.Count & " cells." & _
vbCrLf & "It took " & CStr(Timer - t1) & " seconds."
End Sub

tnuis
09-27-2013, 09:55 AM
Hmmm.... When I run the code in a blank sheet I get error Message: Compile Error: Sub or Function not defined. And the debug is highlighting "SpeedOn" as yellow.

Also GetObject() doesn´t seem to make any noticeable difference since Outlook is always open anyway. I´m pretty sure that the problem lies AFTER this since this pops up instantly, but then it will stay blank until code is finished running.

There are 2 Things that I think are interesting though, 1. When I use another macrobutton "SaveAsPDF" (not in Outlook, just to you desktop for example) then it creates the PDF´s in a heartbeat. It is my understanding that it´s the same PDF convertion function that is used. Also point 2. I found that if I let my original code run for 4 minutes till it´s done and then Close the mail and instantly hit the macro button "MailTo" again then it runs in less than 10 Seconds. If I Close the excelprogram and reopen the first time always takes 4-5 minutes for the MailTo code to run. It takes quite a while for the msgbox to popup showing that it´s Publishing the files one by one. For each visible sheet it needs a lot of time to start Publishing.

My best Guess would be that the problem lies in the following part of the code:
[CODE][For Each ws In Sheets
If ws.Visible = True Then
FullPath = ThisWorkbook.Path & "\" & ws.Name & ".PDF"

ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=FullPath
End If
Next/CODE]

Any other suggestions?

Kenneth Hobs
09-27-2013, 11:03 AM
Obviously, you would need the Speedon routine installed for it to work.

Use the Timer to time how long each PDF takes to create. Use Debug.print to show the results of timer after each file is created. Use DoEvents as I explained.

Because you get a message does not mean that all things were completed.

SamT
09-29-2013, 07:16 AM
The Signature + htmlBody Assignment is the problem. Do the commented) Signature assignment in this code and see if it fixes your speed issue.

Option Explicit

Sub Mailto_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String
Dim FullPath As String
Dim ws As Worksheet

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Signature = OutMail.htmlbody 'Resolution problem

Application.ScreenUpdating = False
Sheet1.Visible = xlSheetHidden
Sheet2.Visible = xlSheetHidden
Sheet5.Visible = xlSheetHidden
Ark6.Visible = xlSheetHidden

With OutMail
'.Display
.To = Range("D10").Value
.CC = ""
.BCC = ""
.Subject = "Papirer Bestilling"
.htmlbody = "Sampletext" & Signature
'*****save as pdf
For Each ws In Sheets
If ws.Visible = True Then
FullPath = ThisWorkbook.Path & "\" & ws.Name & ".PDF"
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FullPath
'****add as attachements
OutMail.Attachments.Add FullPath
End If
Next
End With
Set OutMail = Nothing
Set OutApp = Nothing

'********
On Error Resume Next
With Sheet1
.Visible = xlSheetVisible
With .ComboBox3
If .Value = "Leie" Or .Value = "Leasing" Then
Ark6.Visible = xlSheetVisible
Sheet5.Visible = xlSheetVisible
'Sheet2 ???
End If
End With
.Activate
'********
End With

Application.ScreenUpdating = True
OutMail.Display
End Sub