Pdf转Excel求助~

凊风

请问能不能用VB宏编写：
   1、让用户指定一文件夹；
   2、逐一识别该文件夹下所有PDf文件，然后逐个PDF、逐页、逐行识别每一个PDF下所有文字和图片，把所有识别出来的内容按原页码存入“转换后+原文件名”.excel中；
   3、“转换后+原文件名”.excel亦存入用户之前所指定的文件夹中；
   4、列出转换成功了哪些PDF，失败了哪些PDF.

FishC

以下是一个使用VBA宏实现PDF转Excel功能的示例代码。请注意，此代码依赖于Adobe Acrobat（完整版，而非Reader）的对象库来提取PDF内容。如果未安装Adobe Acrobat，宏可能无法正常运行。此外，图片提取功能较为复杂，本示例仅实现文本提取；如需图片提取，可能需要额外工具或库。

1. 
   
2. Option Explicit
   
3. 
   
4. Sub PDFToExcel()
   
5.     Dim folderPath As String
   
6.     Dim pdfFile As String
   
7.     Dim excelApp As Object
   
8.     Dim excelWorkbook As Object
   
9.     Dim excelWorksheet As Object
   
10.     Dim acroApp As Object
    
11.     Dim acroDoc As Object
    
12.     Dim pageCount As Integer
    
13.     Dim i As Integer
    
14.     Dim outputFileName As String
    
15.     Dim successList As String
    
16.     Dim failList As String
    
17.    
    
18.     ' 获取用户指定的文件夹路径
    
19.     With Application.FileDialog(msoFileDialogFolderPicker)
    
20.         .Title = "请选择包含PDF文件的文件夹"
    
21.         If .Show = -1 Then
    
22.             folderPath = .SelectedItems(1)
    
23.         Else
    
24.             MsgBox "未选择文件夹，操作已取消。"
    
25.             Exit Sub
    
26.         End If
    
27.     End With
    
28.    
    
29.     ' 初始化成功和失败列表
    
30.     successList = ""
    
31.     failList = ""
    
32.    
    
33.     ' 遍历文件夹中的所有PDF文件
    
34.     pdfFile = Dir(folderPath & "\*.pdf")
    
35.     Do While pdfFile <> ""
    
36.         On Error GoTo ErrorHandler
    
37.         Set acroApp = CreateObject("AcroExch.App")
    
38.         Set acroDoc = CreateObject("AcroExch.PDDoc")
    
39.         
    
40.         ' 打开PDF文件
    
41.         If acroDoc.Open(folderPath & "" & pdfFile) Then
    
42.             pageCount = acroDoc.GetNumPages()
    
43.             
    
44.             ' 创建新的Excel工作簿
    
45.             Set excelApp = CreateObject("Excel.Application")
    
46.             Set excelWorkbook = excelApp.Workbooks.Add
    
47.             Set excelWorksheet = excelWorkbook.ActiveSheet
    
48.             excelApp.Visible = False ' 可选：隐藏Excel窗口以提高速度
    
49.             
    
50.             ' 逐页提取文本并写入Excel
    
51.             For i = 0 To pageCount - 1
    
52.                 Dim page As Object
    
53.                 Set page = acroDoc.AcquirePage(i)
    
54.                 Dim text As String
    
55.                 text = page.GetText() ' 提取页面文本
    
56.                 excelWorksheet.Cells(i + 1, 1).Value = "页码 " & (i + 1)
    
57.                 excelWorksheet.Cells(i + 1, 2).Value = text
    
58.             Next i
    
59.             
    
60.             ' 保存Excel文件
    
61.             outputFileName = folderPath & "\转换后" & Replace(pdfFile, ".pdf", "") & ".xlsx"
    
62.             excelWorkbook.SaveAs outputFileName
    
63.             excelWorkbook.Close
    
64.             excelApp.Quit
    
65.             
    
66.             ' 释放对象
    
67.             Set page = Nothing
    
68.             acroDoc.Close
    
69.             Set acroDoc = Nothing
    
70.             acroApp.Exit
    
71.             Set acroApp = Nothing
    
72.             
    
73.             ' 记录成功文件
    
74.             successList = successList & pdfFile & vbCrLf
    
75.         Else
    
76.             GoTo ErrorHandler
    
77.         End If
    
78.         
    
79.         pdfFile = Dir
    
80.         GoTo NextFile
    
81.         
    
82. ErrorHandler:
    
83.         ' 记录失败文件
    
84.         failList = failList & pdfFile & vbCrLf
    
85.         On Error GoTo 0
    
86.         ' 清理对象
    
87.         If Not acroDoc Is Nothing Then
    
88.             acroDoc.Close
    
89.             Set acroDoc = Nothing
    
90.         End If
    
91.         If Not acroApp Is Nothing Then
    
92.             acroApp.Exit
    
93.             Set acroApp = Nothing
    
94.         End If
    
95.         If Not excelWorkbook Is Nothing Then
    
96.             excelWorkbook.Close False
    
97.             Set excelWorkbook = Nothing
    
98.         End If
    
99.         If Not excelApp Is Nothing Then
    
100.             excelApp.Quit
     
101.             Set excelApp = Nothing
     
102.         End If
     
103.         
     
104. NextFile:
     
105.     Loop
     
106.    
     
107.     ' 显示转换结果
     
108.     Dim resultMsg As String
     
109.     resultMsg = "转换完成！" & vbCrLf & vbCrLf
     
110.     If successList <> "" Then
     
111.         resultMsg = resultMsg & "成功转换的文件：" & vbCrLf & successList & vbCrLf
     
112.     End If
     
113.     If failList <> "" Then
     
114.         resultMsg = resultMsg & "转换失败的文件：" & vbCrLf & failList
     
115.     End If
     
116.     MsgBox resultMsg
     
117. End Sub
     

复制代码

**使用说明：**
1. 在Excel中，按 Alt + F11 打开VBA编辑器。
2. 在工具菜单中，选择“引用”，然后勾选 Adobe Acrobat 或类似对象库（具体名称可能因版本而异）。
3. 将上述代码粘贴到一个新模块中。
4. 运行宏 PDFToExcel，按照提示选择文件夹。

**注意事项：**
- 此代码仅提取文本，不处理图片。如需图片提取，可能需要使用Adobe Acrobat的JavaScript或其他第三方库。
- 确保PDF文件未被其他程序占用，否则可能导致失败。
- 转换速度取决于PDF大小和数量，建议先测试少量文件。

如果遇到问题，请检查Adobe Acrobat安装及引用设置。

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。