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
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