PDF to excel

Visakh

New Member
Joined
Jul 15, 2014
Messages
39
Hi,

We managed to write a macro to copy text from PDF to excel. It works, however when it copies the data to excel, it fails to retain the original format. All we need the text to appear Justified and aligned correctly.

Sub RoundedRectangle1_Click()


Application.DisplayAlerts = False
Application.EnableEvents = True
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'==========================================='
Call Portfolio
'==========================================='
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub


Sub Portfolio()
Dim WrdArray() As String
Dim StrPath As String
Dim SrtFolderPath As String


SrtFolderPath = InputBox(prompt:="Enter the Full Path Here", Title:="Enter Path", Default:="P:\REPORTING\LOCATION - REPORTING\London\FUNDS\Miscellaneous\Macro-RBC Transactions")

StrTemplatePath = "U:\Visakh"

MyFolder = SrtFolderPath
Dim fls, f
Set fls = GetFiles(SrtFolderPath & "", "*.pdf*")
path = StrTemplatePath & ""
'## Open both workbooks first:

Set x = Workbooks.Open(StrTemplatePath & "Template.xlsx")
For Each f In fls


'MyOldFile = Shell("C:\Program Files (x86)\Adobe\Reader 10.0\Reader\AcroRd32.exe " & f, vbNormalFocus)
ActiveWorkbook.FollowHyperlink f


'send key to select all text
SendKeys "^a", True
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' send key to copy
SendKeys "^c"
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' activate this workook and paste the data
x.Activate
Sheets("Sheet1").Select
Columns(1).ClearContents
Range("A2").Select
ActiveSheet.Paste


'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value Like "*Important information*") Then


Rows(i & ":" & Last).EntireRow.Delete

End If
Next i
'=========================================================================='


'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value Like "*Fund facts*") Or (Cells(i, "A").Value Like "*Fund launch*") Then

strfundfacts = i + 20



End If
Next i
'=========================================================================='

strfundfactsnew = strfundfacts - 20

For Each Cell In ActiveSheet.Range("A" & strfundfactsnew & ":A" & strfundfacts)
If Cell.Value Like "*Morgan Stanley Investment*" Then
matchRow = Cell.Row

Rows(strfundfactsnew & ":" & matchRow).EntireRow.Delete


End If
Next


'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value Like "*Fund facts*") Or (Cells(i, "A").Value Like "*Fund fact s*") Then


Rows(i).EntireRow.Delete

End If
Next i


'=========================================================================='

' send key to close pdf file
SendKeys "^q"
Application.Wait Now + TimeValue("00:00:2")


On Error Resume Next
'MyNewFile = MyFolder & "" & StrAccountnumber & ".pdf"
MyNewFile = MyFolder & "\rahul.pdf"
'If FileThere(path & StrNewFileName) Then

'Else

Name f As path & MyNewFile

'End If
On Error GoTo 0
Application.Wait Now + TimeValue("00:00:2")

Next f
x.Activate

Lastt = Cells(Rows.count, "A").End(xlUp).Row
Range("A1:A" & Lastt).Select
Range("A1:A" & Lastt).HorizontalAlignment = xlJustify
Range("A1:A" & Lastt).VerticalAlignment = xlTop

Selection.Copy
Set x1 = Workbooks.Open(StrTemplatePath & "Final_output.xls")
Sheets(1).Select
Range("A12:J150").ClearComments
Range("A12").Select

On Error Resume Next
ActiveSheet.Paste
On Error GoTo 0

Range("A12:A150").HorizontalAlignment = xlPageBreakFull

Range("A12:A150").VerticalAlignment = xlTop
Range("A12:A150").Rows.AutoFit

'========== Merge Cells in Commentary ============================== '
Range("A12:J12").Merge
Range("A13:J13").Merge
Range("A14:J14").Merge
Range("A15:J15").Merge
Range("A16:J16").Merge
Range("A17:J17").Merge
Range("A18:J18").Merge
Range("A19:J19").Merge
Range("A20:J20").Merge
Range("A21:J21").Merge
Range("A22:J22").Merge
Range("A23:J23").Merge
Range("A24:J24").Merge
Range("A25:J25").Merge
Range("A26:J26").Merge
Range("A27:J27").Merge
Range("A28:J28").Merge
Range("A29:J29").Merge
Range("A30:J30").Merge
Range("A31:J31").Merge
Range("A32:J32").Merge
Range("A33:J33").Merge
Range("A34:J34").Merge
Range("A35:J35").Merge
Range("A36:J36").Merge
Range("A37:J37").Merge
Range("A38:J38").Merge
Range("A39:J39").Merge
Range("A40:J40").Merge
Range("A41:J41").Merge
Range("A42:J42").Merge
Range("A43:J43").Merge
Range("A44:J44").Merge
Range("A45:J45").Merge
Range("A46:J46").Merge
Range("A47:J47").Merge
Range("A48:J48").Merge
Range("A49:J49").Merge
Range("A50:J50").Merge
Range("A51:J51").Merge
Range("A52:J52").Merge
Range("A53:J53").Merge
Range("A54:J54").Merge
Range("A55:J55").Merge
Range("A56:J56").Merge
Range("A57:J57").Merge
Range("A58:J58").Merge
Range("A59:J59").Merge
Range("A60:J60").Merge
Range("A61:J61").Merge
Range("A62:J62").Merge
Range("A63:J63").Merge
Range("A64:J64").Merge
Range("A65:J65").Merge
Range("A66:J66").Merge
Range("A67:J67").Merge
Range("A68:J68").Merge
Range("A69:J69").Merge
Range("A70:J70").Merge
Range("A71:J71").Merge
Range("A72:J72").Merge
Range("A73:J73").Merge
Range("A74:J74").Merge
Range("A75:J75").Merge
Range("A76:J76").Merge
Range("A77:J77").Merge
Range("A78:J78").Merge
Range("A79:J79").Merge
Range("A80:J80").Merge
Range("A81:J81").Merge
Range("A82:J82").Merge
Range("A83:J83").Merge
Range("A84:J84").Merge
Range("A85:J85").Merge
Range("A86:J86").Merge
Range("A87:J87").Merge
Range("A88:J88").Merge
Range("A89:J89").Merge
Range("A90:J90").Merge
Range("A91:J91").Merge
Range("A92:J92").Merge
Range("A93:J93").Merge
Range("A94:J94").Merge
Range("A95:J95").Merge
Range("A96:J96").Merge
Range("A97:J97").Merge
Range("A98:J98").Merge
Range("A99:J99").Merge
Range("A100:J100").Merge
Range("A101:J101").Merge
Range("A102:J102").Merge
Range("A103:J103").Merge
Range("A104:J104").Merge
Range("A105:J105").Merge
Range("A106:J106").Merge
Range("A107:J107").Merge
Range("A108:J108").Merge
Range("A109:J109").Merge
Range("A110:J110").Merge
Range("A111:J111").Merge
Range("A112:J112").Merge
Range("A113:J113").Merge
Range("A114:J114").Merge
Range("A115:J115").Merge
Range("A116:J116").Merge
Range("A117:J117").Merge
Range("A118:J118").Merge
Range("A119:J119").Merge
Range("A120:J120").Merge
Range("A121:J121").Merge
Range("A122:J122").Merge
Range("A123:J123").Merge
Range("A124:J124").Merge
Range("A125:J125").Merge
Range("A126:J126").Merge
Range("A127:J127").Merge
Range("A128:J128").Merge
Range("A129:J129").Merge
Range("A130:J130").Merge
Range("A131:J131").Merge
Range("A132:J132").Merge
Range("A133:J133").Merge
Range("A134:J134").Merge
Range("A135:J135").Merge
Range("A136:J136").Merge
Range("A137:J137").Merge
Range("A138:J138").Merge
Range("A139:J139").Merge
Range("A140:J140").Merge
Range("A141:J141").Merge
Range("A142:J142").Merge
Range("A143:J143").Merge
Range("A144:J144").Merge
Range("A145:J145").Merge
Range("A146:J146").Merge
Range("A147:J147").Merge
Range("A148:J148").Merge
Range("A149:J149").Merge
Range("A150:J150").Merge


'========== Merge Cells in Commentary ============================== '

Range("A12:A150").Rows.AutoFit
Range("A12:J150").Select
Range("A12:J150").Font.Size = 14


Call sbVBS_To_Delete_Blank_Rows_In_Range



'========= Copy Excel to Word Doc File ========================='

Call ypadtorightFor50CharacterString






x.Close
x1.Activate
Call ExportToPDF
MsgBox "Macro Complete."
End Sub
Function GetFiles(path As String, Optional pattern As String = "") As Collection
Dim rv As New Collection, f
If Right(path, 1) <> "" Then path = path & ""
f = Dir(path & pattern)
Do While Len(f) > 0
rv.Add path & f
f = Dir() 'no parameter
Loop
Set GetFiles = rv
End Function


Function FileThere(FileName As String) As Boolean
FileThere = (Dir(FileName) > "")
End Function


Sub ExportToPDF()


Sheets(1).Activate
ActiveSheet.UsedRange.Select

strdate = Date


strdate = Format(strdate, "dd-mm-yyyy")

Call PDFFormat
Sheets(1).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"U:" & strdate & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub




Function PDFFormat()


Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(1)
.RightMargin = Application.InchesToPoints(1)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True

End Function


Sub sbVBS_To_Delete_Blank_Rows_In_Range()
Dim iCntr
Dim rng As Range
Set rng = Range("A12:A150")
For iCntr = rng.Row + rng.Rows.count - 1 To rng.Row Step -1
If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete
Next
End Sub




Sub ypadtorightFor50CharacterString()
For Each Cell In [a:a]
If Cell = "" Then Exit Sub
Cell.Value = Cell.Value & WorksheetFunction.Rept(" ", 50 - Len(Cell))
Next Cell
End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Forum statistics

Threads
1,141,284
Messages
5,705,502
Members
421,399
Latest member
hjweiss00

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