EXCEL MACRO pdf файлы на один лист Excel - PullRequest
Новая
       9

EXCEL MACRO pdf файлы на один лист Excel

0 голосов
/ 01 сентября 2018

Может ли кто-нибудь помочь с кодом Excel VBA для следующих требований ... Мне нужно извлечь несколько деталей из файла PDF один за другим из папки и вставить его в Excel под каждым столбцом ...

1 Ответ

0 голосов
/ 02 сентября 2018

Я думаю, вам следует преобразовать PDF-файлы в текстовые файлы и импортировать текст в Excel. 

Sub convertpdf2()

Dim AcroXApp As Acrobat.AcroApp
Dim AcroXAVDoc As Acrobat.AcroAVDoc
Dim AcroXPDDoc As Acrobat.AcroPDDoc
Dim Filename As String
Dim jsObj As Object
Dim NewFileName As String

Filename = "C:\Documents and Settings\xxx\Desktop\file01.pdf"
NewFileName = "U:\file.txt"

Set AcroXApp = CreateObject("AcroExch.App")
'AcroXApp.Show

Set AcroXAVDoc = CreateObject("AcroExch.AVDoc")
AcroXAVDoc.Open Filename, "Acrobat"

Set AcroXPDDoc = AcroXAVDoc.GetPDDoc


Set jsObj = AcroXPDDoc.GetJSObject


jsObj.SaveAs NewFileName, "com.adobe.acrobat.plain-text"


AcroXAVDoc.Close False
AcroXApp.Hide
AcroXApp.Exit

End Sub

Вам необходимо установить Adobe Acrobat.

Чтобы импортировать все текстовые файлы в папке, в Excel, попробуйте следующий скрипт. 

Sub Test()

    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub
...