Sub pdfToExcel()
Dim acroapp As Object, acroAVDoc As Object, acroPDDoc As Object, jsobj As Object
Dim filePath, savePath As String
Dim fso As Object, objFile As Object
Set fso = CreateObject("scripting.filesystemobject")
Set acroapp = CreateObject("AcroExch.App")
Set acroAVDoc = CreateObject("AcroExch.AVDoc")
filePath = Application.GetOpenFilename("文件(*.pdf),*.pdf;*.PDF", , "请选择文件", , True)
For i = LBound(filePath) To UBound(filePath)
Set objFile = fso.Getfile(filePath(i))
savePath = Replace(objFile.Path, ".pdf", ".xlsx", , , vbTextCompare)
If acroAVDoc.Open(filePath(i), "") Then
Set acroPDDoc = acroAVDoc.GetPDDoc
Set jsobj = acroPDDoc.GetJSObject
jsobj.SaveAs savePath, "com.adobe.acrobat.xlsx"
acroAVDoc.Close True
End If
Next i
End Sub
第5行:创建fso对象
第6行:创建Acrobat对象
第7行:创建PDF文档对象
第8行:使用getopenFilename获取PDF文件路径
第9行:循环选取的PDF文件路径
第10行:使用FSO获取文件
第11行:将文件路径的.pdf替换为.xlsx,作为保存路径
第12行:打开PDF文件
第13行:获取PDF页面
第14行:获取js对象
第15行:将PDF另存为xlsx格式的Excel文档
第16行:关闭PDF
下面来看看转换效果
二、PDF转PPT
Sub pdfToPPT()
Dim acroapp As Object, acroAVDoc As Object, acroPDDoc As Object, jsobj As Object
Dim filePath, savePath As String
Dim fso As Object, objFile As Object
Set fso = CreateObject("scripting.filesystemobject")
Set acroapp = CreateObject("AcroExch.App")
Set acroAVDoc = CreateObject("AcroExch.AVDoc")
filePath = Application.GetOpenFilename("文件(*.pdf),*.pdf;*.PDF", , "请选择文件", , True)
For i = LBound(filePath) To UBound(filePath)
Set objFile = fso.Getfile(filePath(i))
savePath = Replace(objFile.Path, ".pdf", ".pptx", , , vbTextCompare)
If acroAVDoc.Open(filePath(i), "") Then
Set acroPDDoc = acroAVDoc.GetPDDoc
Set jsobj = acroPDDoc.GetJSObject
jsobj.SaveAs savePath, "com.adobe.acrobat.pptx"
acroAVDoc.Close True
End If
Next i
End Sub
savePath = Replace(objFile.Path, ".pdf", ".pptx", , , vbTextCompare)
第15行:xlsx更改为pptx
jsobj.SaveAs savePath, "com.adobe.acrobat.pptx"
三、PDF转jpg图片
Sub pdfToJPG()
Dim acroapp As Object, acroAVDoc As Object, acroPDDoc As Object, jsobj As Object
Dim filePath, savePath As String
Dim fso As Object, objFile As Object
Set fso = CreateObject("scripting.filesystemobject")
Set acroapp = CreateObject("AcroExch.App")
Set acroAVDoc = CreateObject("AcroExch.AVDoc")
filePath = Application.GetOpenFilename("文件(*.pdf),*.pdf;*.PDF", , "请选择文件", , True)
For i = LBound(filePath) To UBound(filePath)
Set objFile = fso.Getfile(filePath(i))
savePath = Replace(objFile.Path, ".pdf", ".jpg", , , vbTextCompare)
If acroAVDoc.Open(filePath(i), "") Then
Set acroPDDoc = acroAVDoc.GetPDDoc
Set jsobj = acroPDDoc.GetJSObject
jsobj.SaveAs savePath, "com.adobe.acrobat.jpeg"
acroAVDoc.Close True
End If
Next i
End Sub
savePath = Replace(objFile.Path, ".pdf", ".jpg", , , vbTextCompare)
第15行:xlsx更改为jpeg
jsobj.SaveAs savePath, "com.adobe.acrobat.jpeg"
四、PDF转TXT
Sub pdfToText()
Dim acroapp As Object, acroAVDoc As Object, acroPDDoc As Object, jsobj As Object
Dim filePath, savePath As String
Dim fso As Object, objFile As Object
Set fso = CreateObject("scripting.filesystemobject")
Set acroapp = CreateObject("AcroExch.App")
Set acroAVDoc = CreateObject("AcroExch.AVDoc")
filePath = Application.GetOpenFilename("文件(*.pdf),*.pdf;*.PDF", , "请选择文件", , True)
For i = LBound(filePath) To UBound(filePath)
Set objFile = fso.Getfile(filePath(i))
savePath = Replace(objFile.Path, ".pdf", ".txt", , , vbTextCompare)
If acroAVDoc.Open(filePath(i), "") Then
Set acroPDDoc = acroAVDoc.GetPDDoc
Set jsobj = acroPDDoc.GetJSObject
jsobj.SaveAs savePath, "com.adobe.acrobat.plain-text"
acroAVDoc.Close True
End If
Next i
End Sub
savePath = Replace(objFile.Path, ".pdf", ".txt", , , vbTextCompare)
第15行:xlsx更改为plain-text
jsobj.SaveAs savePath, "com.adobe.acrobat.plain-text"
好了,本期教程就到这里啦,走过路过的点个关注分享一下吧,谢谢啦,如果你是一个VBA小白,想要了解该如何开始学习VBA,建议看看以下文章
Excel VBA学习路线知识框架梳理(小白VBA入门必看-建议收藏)