I would to convert the data type from pdf to xlsb

Mustafa elkarim

New Member
Joined
Nov 25, 2019
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
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
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,566
Office Version
  1. 2007
Platform
  1. Windows
Try this

VBA Code:
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
 

Forum statistics

Threads
1,140,924
Messages
5,703,180
Members
421,280
Latest member
Jaycee01

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top