Strange delay in execution of MailTo Macro code

[tnuis]

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