Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #6  
Old 06-08-2017, 12:54 PM
charlesdh charlesdh is offline Extract column from Pdf to Excel file Windows 7 32bit Extract column from Pdf to Excel file Office 2010 32bit
Expert
 
Join Date: Apr 2014
Location: Mississippi
Posts: 382
charlesdh is on a distinguished road
Default

Hi,

You need to extract the data to a excel workbook. You can then be able to extract the data you require for it to the actual workbook.
The following is a code that I used when I had a Trial copy of Adobe.

Code:
Option Base 1

Sub CQCard_Process()
Application.ScreenUpdating = False
Dim myArray As Variant
Dim Mycount As Long
Dim CurFile As String
Dim Destwb As Workbook
Dim rng As Range
Dim mydt As String
Dim lrow As Long
Dim Onr As String
Dim sFileName As String
myArray = Array("OrderNr.", "FileNr", "Indent", "Date Of Order")
lrow = Range("A" & Rows.Count).End(xlUp).Row

Const DirLoc As String = "C:\QCCard\"


CurFile = Dir(DirLoc & "*.XLSX")
''' CHeck to see if you have QCCards to process.'''
If CurFile = "" Then
    MsgBox "You do not have QC Cards to process!"
    Exit Sub
End If
Do While CurFile <> vbNullString ''' we open new workbook tehn populate it with the data
    CurFile = Dir(DirLoc & "*.XLSX")
    If CurFile = "" Then Exit Sub
    Dim Origwb As Workbook
    Set Destwb = Workbooks.Add
    Set Origwb = Workbooks.Open(Filename:=DirLoc & CurFile) ''Here we open each workbook in the file
    '''  Populate the data to new workbook '''
    With Origwb
        .Sheets("Table 1").Range("AC8").WrapText = False
        .Sheets("Table 1").Range("AC3").WrapText = False
        .Sheets("Table 1").Range("v2").WrapText = False
        .Sheets("Table 1").Range("c1").WrapText = False
        .Sheets("Table 1").Range("AC8").MergeCells = False
        .Sheets("Table 1").Range("AC3").MergeCells = False
        .Sheets("Table 1").Range("v2").MergeCells = False
        .Sheets("Table 1").Range("c1").MergeCells = False
    End With
   Destwb.Activate
    Set rng = ActiveSheet.Range("A1:D1")
    With Destwb
        With Worksheets("Sheet1")
            For Mycount = 1 To UBound(myArray)
                .Cells(1, Mycount).Value = myArray(Mycount)
            Next Mycount
        End With
        Origwb.Sheets("Table 1").Range("AC8").Value = Replace(Right(Origwb.Sheets("Table 1").Range("AC8").Value, _
            Len(Origwb.Sheets("Table 1").Range("AC8").Value) - InStr(Origwb.Sheets("Table 1").Range("AC8").Value, Chr(10))), " ", "")
            
        Origwb.Sheets("Table 1").Range("AC3").Value = Replace(Right(Origwb.Sheets("Table 1").Range("AC3").Value, _
            Len(Origwb.Sheets("Table 1").Range("AC3").Value) - InStr(Origwb.Sheets("Table 1").Range("AC3").Value, Chr(10))), " ", "")
            
        Origwb.Sheets("Table 1").Range("c1").Value = Replace(Right(Origwb.Sheets("Table 1").Range("c1").Value, _
            Len(Origwb.Sheets("Table 1").Range("c1").Value) - InStr(Origwb.Sheets("Table 1").Range("c1").Value, Chr(10))), " ", "")
            
        Origwb.Sheets("Table 1").Range("v2").Value = Replace(Right(Origwb.Sheets("Table 1").Range("v2").Value, _
            Len(Origwb.Sheets("Table 1").Range("v2").Value) - InStr(Origwb.Sheets("Table 1").Range("v2").Value, Chr(10))), " ", "")
        mydt = Format(Origwb.Sheets("Table 1").Range("AC8").Value, "mm-dd-yy")
    
        .Sheets("Sheet1").Range("A2").Value = Trim(Mid(Origwb.Sheets("Table 1") _
            .Range("AC3").Value, InStr(1, Origwb.Sheets("Table 1").Range("Ac3").Text, " #") + 1)) '''order
            
        .Sheets("Sheet1").Range("B2").Value = Trim(Mid(Origwb.Sheets("Table 1") _
            .Range("V2").Value, InStr(1, Origwb.Sheets("Table 1").Range("V2").Text, " #") + 1))
            
        .Sheets("Sheet1").Range("C2").Value = Trim(Mid(Origwb.Sheets("Table 1") _
            .Range("C1").Value, InStr(1, Origwb.Sheets("Table 1").Range("C1").Text, ".") + 1)) '' Indent
            
        .Sheets("sheet1").Range("D2").Value = mydt ''' Date

        Title = Destwb.Sheets("Sheet1").Range("A2") & "_" & Destwb.Sheets("Sheet1") _
            .Range("B2") & "_" & mydt
            sFileName = "C:\QCCard\QCCompleted\" & Title
            ActiveWorkbook.SaveAs Filename:=sFileName ', FileFormat:=51
            ActiveWorkbook.Close SaveChanges:=True
            Application.EnableEvents = False
            '''''''' Move file to QCProcessed we will kill the original
            ActiveWorkbook.SaveAs "C:\QCCard\QCProcessed\" & Origwb.Name
            ActiveWorkbook.Close
            Kill "C:\QCCard\" & CurFile
            Application.EnableEvents = True
    End With
   ' Next i
  Loop
  Application.ScreenUpdating = True
  MsgBox "QCCard Run Complete"
End Sub
When you extract the PDF to excel you can post it here and I or someone my be able to help.
Reply With Quote
 

Tags
excel vba acceleration



Similar Threads
Thread Thread Starter Forum Replies Last Post
Extract data based on pattern with respect to specific column PRA007 Excel Programming 14 12-04-2015 04:32 AM
Macro to highlight repeated words in word file and extract into excel file aabri Word VBA 1 06-14-2015 07:20 AM
Extract column from Pdf to Excel file How do I extract all my email addresses into one file? JohnFurter Outlook 3 05-16-2015 04:32 AM
Extract column from Pdf to Excel file Extract phone number from word file donlincolnmsof Word VBA 12 06-19-2012 05:21 PM
Extract column from Pdf to Excel file Extract Video from .ppsx file designer PowerPoint 1 10-14-2011 08:00 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 07:59 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft