Read Table from pdf using acrobat pro and vba

Option Explicit
Public Const pdf_file  As String = "C:\Users\allso\Desktop\table.pdf"



Sub pdftoexcel()
Dim eapp As Acrobat.AcroApp
Dim av_doc As CAcroAVDoc
Dim pdf_doc As CAcroPDDoc
Dim sel_text As CAcroPDTextSelect
Dim i, j As Long
Dim pagenumber, pagecontent, content
Dim data_print As Boolean
Dim cnt As Long
Dim currow As Long
currow = 1
Sheets("PDF_To_Excel").Select
Cells.Clear


Set eapp = CreateObject("AcroExch.App")
Set av_doc = CreateObject("AcroExch.AVDoc")
If av_doc.Open(pdf_file, vbNull) <> True Then Exit Sub
While av_doc Is Nothing
Set av_doc = eapp.GetActiveDoc
Wend
Set pdf_doc = av_doc.GetPDDoc
For i = 0 To pdf_doc.GetNumPages - 1
Set pagenumber = pdf_doc.AcquirePage(i)
Set pagecontent = CreateObject("AcroExch.HiliteList")
On Error Resume Next
If pagecontent.Add(0, 9000) <> True Then Exit Sub
Set sel_text = pagenumber.CreatePageHilite(pagecontent)
On Error GoTo 0

For j = 0 To sel_text.GetNumText - 1
'Debug.Print sel_text.GetText(j)
'content = sel_text.GetNumText(j)
content = sel_text.GetText(j)
If content Like "*Disability*" Then
data_print = True
ElseIf content Like "*Postal*" Then
data_print = False
Exit For
End If

If data_print = True Then
cnt = cnt + 1
Cells(currow, cnt) = Application.WorksheetFunction.Clean(Trim(content))
'Debug.Print content
End If

If cnt = 6 Then
cnt = 0
currow = currow + 1
End If

'Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = sel_text.GetText(j)
Next j

Next i

av_doc.Close False
eapp.Exit
Set sel_text = Nothing
Set pagenumber = Nothing
Set eapp = Nothing
Set av_doc = Nothing
Set pdf_doc = Nothing
End Sub

Get text data from pdf to excel range using acrobat library in VBA

First we need to add the acrobat reference and see if Adobe Acrobat 10.0 Type Library is enabled

Option Explicit

Public Const pdf_file  As String = "C:\Users\allso\Desktop\Business Loan Application Form.pdf"



Sub pdftoexcel()
Dim eapp As Acrobat.AcroApp
Dim av_doc As CAcroAVDoc
Dim pdf_doc As CAcroPDDoc
Dim sel_text As CAcroPDTextSelect
Dim i, j As Long
Dim pagenumber, pagecontent, content
Set eapp = CreateObject("AcroExch.App")
Set av_doc = CreateObject("AcroExch.AVDoc")
If av_doc.Open(pdf_file, vbNull) <> True Then Exit Sub
While av_doc Is Nothing
Set av_doc = eapp.GetActiveDoc
Wend
Set pdf_doc = av_doc.GetPDDoc
For i = 0 To pdf_doc.GetNumPages - 1
Set pagenumber = pdf_doc.AcquirePage(i)
Set pagecontent = CreateObject("AcroExch.HiliteList")
On Error Resume Next
If pagecontent.Add(0, 9000) <> True Then Exit Sub
Set sel_text = pagenumber.CreatePageHilite(pagecontent)
On Error GoTo 0

For j = 0 To sel_text.GetNumText - 1
'Debug.Print sel_text.GetText(j)
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = sel_text.GetText(j)
Next j

Next i

av_doc.Close False
eapp.Exit
Set sel_text = Nothing
Set pagenumber = Nothing
Set eapp = Nothing
Set av_doc = Nothing
Set pdf_doc = Nothing
End Sub

Check if a folder exists in a path ,if not create it,then save all the sheets in a workbook in that folder with a name containing workbookname and current time in "yyyymmdd\_hhmmss" format

Option Explicit
Function Path_Exists(Path As String) As String

'Dim Path As String
Dim Folder As String
Dim Answer As VbMsgBoxResult

   ' Path = "C:\Users\allso\Desktop\excel_to_pdf"

    Folder = dir(Path, vbDirectory)
' MsgBox (Path)
' MsgBox (Folder)
    If Folder = vbNullString Then

        Answer = MsgBox("Path does not exist. Would you like to create it?", vbYesNo, "Create Path?")

        Select Case Answer
            Case vbYes
                VBA.FileSystem.MkDir (Path)
            Case Else
                Exit Function
        End Select

    Else

       ' MsgBox "Folder exists."

    End If
   Path_Exists = Path
End Function

Sub vba_excel_to_pdf()
'Path_Exists ("C:\Users\allso\Desktop\excel_to_pdf")
Dim output_file As String, ws_count, I As Integer
'output_file = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & ".pdf"
'MsgBox (output_file)
'Set the location where the pdfs will be saved

'Dim pdffolder As FileDialog
'
'
'
'
'Set pdffolder = Application.FileDialog(msoFileDialogFolderPicker)
'pdffolder.AllowMultiSelect = False
'pdffolder.Show
'
'
  
Dim dir As String
'dir = pdffolder.SelectedItems(1)
dir = Path_Exists("C:\Users\allso\Desktop\excel_to_pdf")
'MsgBox (dir)
Dim strtime As String


' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dir & "\" & customer_code & ".pdf", openafterpublish:=False
 ' Set WS_Count equal to the number of worksheets in the active
        
         ws_count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 1 To ws_count

            ' Insert your code here.
            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
           ' MsgBox ActiveWorkbook.Worksheets(I).Name
          
        strtime = Format(Now(), "yyyymmdd\_hhmmss")
       ' MsgBox (strtime)
           output_file = dir & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "." & ActiveWorkbook.Worksheets(I).Name & "." & strtime & ".pdf"
           'MsgBox (output_file)

           ActiveWorkbook.Worksheets(I).ExportAsFixedFormat xlTypePDF, output_file, xlQualityStandard, openafterpublish:=False
           'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=output_file, openafterpublish:=False

         Next I

End Sub


Source:https://www.contextures.com/excelvbapdf.html

check if a folder exists in a path and if not create the folder in that path on user prompt using vba

Sub Path_Exists()

Dim Path As String
Dim Folder As String
Dim Answer As VbMsgBoxResult

    Path = "C:\Users\allso\Desktop\excel_to_pdf"

    Folder = dir(Path, vbDirectory)
 
    If Folder = vbNullString Then

        Answer = MsgBox("Path does not exist. Would you like to create it?", vbYesNo, "Create Path?")

        Select Case Answer
            Case vbYes
                VBA.FileSystem.MkDir (Path)
            Case Else
                Exit Sub
        End Select

    Else

        MsgBox "Folder exists."

    End If

End Sub

Create a clustered bar chart using vba

This is my Source Data

I need to create a clustered bar chart using this data as source

to do this

Option Explicit

Sub chartcreationpart1()

'Declare some variables

Dim Chrt As ChartObject

Dim DataRng As Range

'Add a chart object, this would be an empty shell

Set Chrt = ActiveSheet.ChartObjects.Add(Left:=400, _

                                        Width:=800, _

                                        Height:=800, _

                                        Top:=50)

    'Define the data to be used in the chart.

    Set DataRng = Range("A1").CurrentRegion

    Chrt.Chart.SetSourceData Source:=DataRng

    

    'Define the type of chart it is.

    Chrt.Chart.ChartType = xlBarClustered

'Lets add a title

Chrt.Chart.HasTitle = True

'Create a reference to that title

Dim ChrtTitle As ChartTitle

Set ChrtTitle = Chrt.Chart.ChartTitle

    

    'Do some formatting with the title.

    ChrtTitle.Text = "Performance"

    ChrtTitle.Shadow = False

    ChrtTitle.Characters.Font.Bold = False

    ChrtTitle.Characters.Font.Name = "Arial Nova"

'Add a legend to the chart

Chrt.Chart.HasLegend = True

'Create a reference to that legend

Dim ChrtLeg As Legend

Set ChrtLeg = Chrt.Chart.Legend

    'Do some formatting

    ChrtLeg.Position = xlLegendPositionTop

    ChrtLeg.Height = 20

'Remove the gridlines

Chrt.Chart.SetElement msoElementPrimaryCategoryGridLinesNone

Chrt.Chart.SetElement msoElementPrimaryValueGridLinesNone

'Make sure the chart has some axes, it's usually true by default

Chrt.Chart.HasAxis(xlCategory, xlPrimary) = True

Chrt.Chart.HasAxis(xlValue, xlPrimary) = True

'Make sure each axis has a title

Chrt.Chart.Axes(xlValue, xlPrimary).HasTitle = True

Chrt.Chart.Axes(xlCategory, xlPrimary).HasTitle = True

'Take the newly created title and create a reference to it.

Dim AxisTitle As AxisTitle

Set AxisTitle = Chrt.Chart.Axes(xlCategory, xlPrimary).AxisTitle

    'Do some formatting.

    AxisTitle.Text = "Years"

    AxisTitle.HorizontalAlignment = xlCenter

    AxisTitle.Characters.Font.Color = vbRed

    

Set AxisTitle = Chrt.Chart.Axes(xlValue, xlPrimary).AxisTitle

    'Do some formatting.

    AxisTitle.Text = "Profit/Cost/Sales"

    AxisTitle.HorizontalAlignment = xlCenter

    AxisTitle.Characters.Font.Color = vbRed

    

    

End Sub

The output chart is

Source:https://www.youtube.com/watch?v=SJHkVFtIO38&list=PLcFcktZ0wnNn0VMRzVqV82s4vKpaTii_W&index=16