PDF Adobe copy to excel

'Word Tables to Excel
'https://social.msdn.microsoft.com/Forums/en-US/22631e7e-53df-47c4-b625-22c9e935f02b/copy-a-table-from-body-of-an-email-to-excel-spreadsheet?forum=outlookdev


'Import Word Tables
'vog, http://www.mrexcel.com/forum/showthread.php?t=382541
'Ruddles, http://www.mrexcel.com/forum/showthread.php?t=524091


'snb, Word Tables
' http://www.vbaexpress.com/forum/showthread.php?t=45520
' http://www.vbaexpress.com/forum/showthread.php?t=46472




Sub SavePDFsAsDOCX()
  Dim a, e, p$
  'p = VBA.Environ$("temp") & "\"
  p = "C:\Users\hobs0003\Dropbox\Excel\pdf\Acrobat\Copy Pall Corp  Inv 2\"
  a = aFFs(p & "*.pdf")
  For Each e In a
    SavePDFasOtherFormat CStr(e), "docx"
  Next e
End Sub


'C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\acrord32.dll
'Mostly like, http://www.myengineeringworld.net/2013/03/vba-macro-to-convert-pdf-files-into.html
Sub SavePDFasOtherFormat(PDFPath As String, FileExtension As String)
  'Saves a PDF file as another format using Adobe Professional.
  'By Christos Samaras
  'http://www.myengineeringworld.net
  'In order to use the macro you must enable the Acrobat library from VBA editor:
  'Go to Tools -> References -> Adobe Acrobat xx.0 Type Library, where xx depends
  'on your Acrobat Professional version (i.e. 9.0 or 10.0) you have installed to your PC.
  'Alternatively you can find it Tools -> References -> Browse and check for the path
  'C:\Program Files\Adobe\Acrobat xx.0\Acrobat\acrobat.tlb
  'where xx is your Acrobat version (i.e. 9.0 or 10.0 etc.).
  'Dim objAcroApp      As Object 'Acrobat.AcroApp
  'Dim objAcroAVDoc    As Object 'Acrobat.AcroAVDoc
  'Dim objAcroPDDoc    As Object 'Acrobat.AcroPDDoc
  Dim objAcroApp      As Acrobat.AcroApp
  Dim objAcroAVDoc    As Acrobat.AcroAVDoc
  Dim objAcroPDDoc    As Acrobat.AcroPDDoc
  Dim objJSO          As Object
  Dim boResult        As Boolean
  Dim ExportFormat    As String
  Dim NewFilePath     As String


  'Check if the file exists.
  If Dir(PDFPath) = "" Then
    MsgBox "Cannot find the PDF file!" & vbCrLf & "Check the PDF path and retry.", _
      vbCritical, "File Path Error"
    Exit Sub
  End If


  'Check if the input file is a PDF file.
  If LCase(Right(PDFPath, 3)) <> "pdf" Then
    MsgBox "The input file is not a PDF file!", vbCritical, "File Type Error"
    Exit Sub
  End If


  'Initialize Acrobat by creating App object.
  Set objAcroApp = CreateObject("AcroExch.App")
  'Set AVDoc object.
  Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")


  'Open the PDF file.
  boResult = objAcroAVDoc.Open(PDFPath, "")


  'Set the PDDoc object.
  Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
  'Set the JS Object - Java Script Object.
  Set objJSO = objAcroPDDoc.GetJSObject


  'Check the type of conversion.
  Select Case LCase(FileExtension)
    Case "eps": ExportFormat = "com.adobe.acrobat.eps"
    Case "html", "htm": ExportFormat = "com.adobe.acrobat.html"
    Case "jpeg", "jpg", "jpe": ExportFormat = "com.adobe.acrobat.jpeg"
    Case "jpf", "jpx", "jp2", "j2k", "j2c", "jpc": ExportFormat = "com.adobe.acrobat.jp2k"
    Case "docx": ExportFormat = "com.adobe.acrobat.docx"
    Case "doc": ExportFormat = "com.adobe.acrobat.doc"
    Case "png": ExportFormat = "com.adobe.acrobat.png"
    Case "ps": ExportFormat = "com.adobe.acrobat.ps"
    Case "rft": ExportFormat = "com.adobe.acrobat.rft"
    Case "xlsx": ExportFormat = "com.adobe.acrobat.xlsx"
    Case "xls": ExportFormat = "com.adobe.acrobat.spreadsheet"
    Case "txt": ExportFormat = "com.adobe.acrobat.accesstext"
    Case "tiff", "tif": ExportFormat = "com.adobe.acrobat.tiff"
    Case "xml": ExportFormat = "com.adobe.acrobat.xml-1-00"
    Case Else: ExportFormat = "Wrong Input"
  End Select


  'Check if the format is correct and there are no errors.
  If ExportFormat <> "Wrong Input" And Err.Number = 0 Then
    'Format is correct and no errors.
    'Set the path of the new file. Note that Adobe instead of xls uses xml files.
    'That's why here the xls extension changes to xml.
    If LCase(FileExtension) <> "xls" Then
      NewFilePath = WorksheetFunction.Substitute(PDFPath, ".pdf", "." & LCase(FileExtension))
    Else
      NewFilePath = WorksheetFunction.Substitute(PDFPath, ".pdf", ".xml")
    End If
    'Save PDF file to the new format.
    boResult = objJSO.SaveAs(NewFilePath, ExportFormat)
    'Close the PDF file without saving the changes.
    boResult = objAcroAVDoc.Close(True)
    'Close the Acrobat application.
    boResult = objAcroApp.Exit
    'Inform the user that conversion was successfully.
    Debug.Print "The PDf file:" & vbNewLine & PDFPath & vbNewLine & vbNewLine & _
    "Was saved as: " & vbNewLine & NewFilePath


    Else
      'Something went wrong, so close the PDF file and the application.
      'Close the PDF file without saving the changes.
      boResult = objAcroAVDoc.Close(True)
      'Close the Acrobat application.
    boResult = objAcroApp.Exit
   'Inform the user that something went wrong.
   Debug.Print "Something went wrong!" & vbNewLine & "The conversion of the following PDF file FAILED:" & _
    vbNewLine & PDFPath
  End If


  'Release the objects.
  Set objAcroPDDoc = Nothing
  Set objAcroAVDoc = Nothing
  Set objAcroApp = Nothing
End Sub
'https://helpx.adobe.com/acrobat/kb/supported-file-formats-acrobat-reader.html


'you can convert the following file types: text (TXT, PS, RTF);
'Adobe Creative Suite® (InDesign®, Photoshop®, and Illustrator®);
'Microsoft Office (DOC, XLS, PPT); Microsoft Office 2010 and 2007
'(DOCX, PPTX, XLSX); Microsoft Publisher 2003 and 2007 (PUB);
'Open Office (ODT, ODP, ODS, ODG, ODF); Star Office (SWX, SXI, SXC, SXD, STW);
'WordPerfect (WPD); and images (BMP, GIF, JPEG, TIFF, PNG).

Sub ImportDOCXs()
  Dim a, e, p$
 'p = VBA.Environ$("temp") & "\"
  a = aFFs(p & "*.docx")
  If Not IsArray(a) Then Exit Sub
  For Each e In a
    ImportDOCxData e
  Next e
End Sub


Sub ImportDOCxData(fn)
  Dim ws As Worksheet, rw As Range, s$
  Dim po$, inn$, id As Date
  Dim a, b, e, i As Integer, j As Integer, k As Integer
  Dim r As Integer, c As Integer
  'Tools > Settings > Microsoft Word xx.0 Object Library
  Dim doc As Word.Document, sh As Word.Shape


  'Worksheet to put Word's content
  Set ws = ThisWorkbook.Worksheets("Data")


  Set doc = GetObject(fn)
  'Build a to hold groupitems text values.
  ReDim a(1 To Rows.Count)  'Overdim, resize/redim later.
  For Each sh In doc.Shapes
    If sh.Type = msoGroup Then
      For i = 1 To sh.GroupItems.Count
        If sh.GroupItems.Item(i).TextFrame.HasText Then
          b = Split(sh.GroupItems.Item(i).TextFrame.TextRange.Text, vbCr)
          For k = 0 To UBound(b)
            j = j + 1
            a(j) = b(k)
          Next k
        End If
      Next i
    End If
  Next sh
  ReDim Preserve a(1 To j)
  'Sheet6.[a1].Resize(j).Value = WorksheetFunction.Transpose(a)
  po = a(5)             'Purchase Order
  inn = Split(a(7))(0)  'Invoice Number
  id = Split(a(7))(1)   'Invoice Date


  With doc.Tables(1)
    r = .Rows.Count
    c = .Columns.Count + 3  'Need to fill po, inn, and id.
    ReDim a(1 To r, 1 To c)
    For i = 1 To r
      For j = 4 To c
        'http://www.vbaexpress.com/forum/showthread.php?36710-Strange-character-on-table-range-text
        'Trim chrw(13)&chrw(7)
        a(i, j) = Replace(.cell(i, j - 3).Range.Text, VBA.ChrW(13) & VBA.ChrW(7), "")
        'a(i, j) = .cell(i, j - 3).Range.Text
      Next j
      a(i, 1) = po
      a(i, 2) = inn
      a(i, 3) = id
    Next i
  End With
  doc.Close False


  'Fill ws with results.
  Set rw = ws.Cells(Rows.Count, "A").End(xlUp).Offset(1)
  rw.Resize(r, c).Value = a
End Sub