I would to convert the data type from pdf to xlsb

[Mustafa elkarim]

Sub Email()

Set OutApp = GetObject(, "Outlook.Application")
Dim IsCreated As Boolean
Dim i As Long
Dim ab, ac, ad, emTo, emCC As String
Dim PdfFile As String, Title As String
Dim OutlApp As Object

Application.ScreenUpdating = False

LoginName = UCase(GetUserID)

Worksheets("DB").Visible = True
Sheets("DB").Select

Range("AM5").Select
Selection.Copy
Range("AW8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("DB").Visible = xlSheetVeryHidden

Sheets("PDF").Visible = True
Sheets("PDF").Select

ActiveSheet.Shapes.Range(Array("Picture 3")).Select
Selection.ShapeRange.Width = 72.72

PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)

emTo = Worksheets("DB").Range("B10").Value
emCC = Worksheets("DB").Range("B14").Value
ab = Worksheets("DB").Range("AP25").Value

' Not sure for what the Title is
Title = " - " & Sheets("DB").Range("D6")
titlef = Sheets("DB").Range("D6") & " - " & Sheets("PDF").Range("F8") & " - " & Format(ab, "ddd dd-mmm-yyyy")

i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = "C:\Users\" & LoginName & "\Desktop\" & Sheets("DB").Range("D6") & " - " & Sheets("PDF").Range("F8") & ".pdf"

'Specify the worksheet name
Sheets("PDF").Activate
ActiveSheet.UsedRange.Select
'ThisWorkbook.Sheets(Array("PDF")).Select

Set xsht = ThisWorkbook.Sheets("PDF")

xsht.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")

If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If

OutlApp.Visible = True
On Error GoTo 0

' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = titlef
.To = emTo ' <-- Put email of the recipient here
.cc = emCC ' <-- Put email of 'copy to' recipient here
.HTMLBody = "Greetings, " & vbLf & vbLf _
& "<p> The attachment here displays the results of the candidate: " & Sheets("pdf").Range("f8") & vbLf _
& "<p> Please open the attachment to see the number of correct and answers and correct the 5 essay questions." & vbLf _
& "<p><i>FYI: The candidate spent " & Sheets("DB").Range("AT25") & " hours & " & Sheets("DB").Range("AT26") & " minutes and got " & Sheets("PDF").Range("E11") & " correct answers in the MCQs.</i>" & vbLf & vbLf _
& "<p><p>All the Best,<br>" & vbLf _
& " " & vbLf & vbLf


.Attachments.Add PdfFile
' Try to send
On Error Resume Next
Set .SendUsingAccount = OutlApp.Session.Accounts.Item(1) 'Use 2nd Account in the list

.DISPLAY
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%s"

Application.Visible = True

On Error GoTo 0
End With

' Delete PDF file
Kill PdfFile

' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit

' Release the memory of object variable
Set OutlApp = Nothing

Worksheets("PDF").Visible = xlSheetVeryHidden

Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

Try this

Sub Email()

  Dim IsCreated As Boolean
  Dim i As Long
  Dim ab, ac, ad, emTo, emCC As String
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object, OutApp
  Dim LoginName, titlef
  Dim xsht As Worksheet, BinFile As String
 
  Set OutApp = GetObject(, "Outlook.Application")
 
  Application.ScreenUpdating = False
 
  LoginName = Application.UserName 'UCase(GetUserID)
 
  Worksheets("DB").Visible = True
  Sheets("DB").Select
 
  Range("AM5").Select
  Selection.Copy
  Range("AW8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 
  Worksheets("DB").Visible = xlSheetVeryHidden
 
  Sheets("PDF").Visible = True
  Sheets("PDF").Select
 
  ActiveSheet.Shapes.Range(Array("Picture 3")).Select
  Selection.ShapeRange.Width = 72.72
 
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
 
  emTo = Worksheets("DB").Range("B10").Value
  emCC = Worksheets("DB").Range("B14").Value
  ab = Worksheets("DB").Range("AP25").Value
 
  ' Not sure for what the Title is
  Title = " - " & Sheets("DB").Range("D6")
  titlef = Sheets("DB").Range("D6") & " - " & Sheets("PDF").Range("F8") & " - " & Format(ab, "ddd dd-mmm-yyyy")
 
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
 
  'PdfFile = "C:\Users\" & LoginName & "\Desktop\" & Sheets("DB").Range("D6") & " - " & Sheets("PDF").Range("F8") & ".pdf"
  BinFile = "C:\Users\" & LoginName & "\Desktop\" & Sheets("DB").Range("D6") & " - " & Sheets("PDF").Range("F8") & ".xlsb"
 
  'Specify the worksheet name
  Sheets("PDF").Activate
  ActiveSheet.UsedRange.Select
  'ThisWorkbook.Sheets(Array("PDF")).Select
 
  Set xsht = ThisWorkbook.Sheets("PDF")
 
  'xsht.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=PdfFile, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
 
  xsht.Copy
  ActiveWorkbook.SaveAs Filename:=BinFile, _
    FileFormat:=xlExcel12, CreateBackup:=False
  ActiveWorkbook.Close False
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
 
  If Err Then
  Set OutlApp = CreateObject("Outlook.Application")
  IsCreated = True
  End If
 
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
    ' Prepare e-mail
    .Subject = titlef
    .To = emTo ' <-- Put email of the recipient here
    .cc = emCC ' <-- Put email of 'copy to' recipient here
    .HTMLBody = "Greetings, " & vbLf & vbLf _
    & "<p> The attachment here displays the results of the candidate: " & Sheets("pdf").Range("f8") & vbLf _
    & "<p> Please open the attachment to see the number of correct and answers and correct the 5 essay questions." & vbLf _
    & "<p><i>FYI: The candidate spent " & Sheets("DB").Range("AT25") & " hours & " & Sheets("DB").Range("AT26") & " minutes and got " & Sheets("PDF").Range("E11") & " correct answers in the MCQs.</i>" & vbLf & vbLf _
    & "<p><p>All the Best,<br>" & vbLf _
    & " " & vbLf & vbLf
    
    
    .Attachments.Add BinFile
    ' Try to send
    On Error Resume Next
    Set .SendUsingAccount = OutlApp.Session.Accounts.Item(1) 'Use 2nd Account in the list
    
    .DISPLAY
    Application.Wait (Now + TimeValue("0:00:01"))
    Application.SendKeys "%s"
    
    Application.Visible = True
    
    On Error GoTo 0
  End With
 
  ' Delete PDF file
  Kill BinFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
  Worksheets("PDF").Visible = xlSheetVeryHidden
 
  Application.ScreenUpdating = True
End Sub