Need help saving an already open pdf file using name from spreadsheet through VBA

M

MatthewBiersay

New Member
Joined
Nov 24, 2024
Messages
5
Office Version
  1. Prefer Not To Say
Platform
  1. Windows
Hello all!
Been trying to figure out this code to do the following:
Save an open pdf file by searching for text within that pdf that matches text in column g, once this match is found it should save the already open pdf file using the adjacent cell in column R. Tried to use co-pilot but pdf won't save:

This is the code below, all help would be appreciated, or alternative ideas. Thank you!

Sub SearchTextInPDFAndSaveToDesktop()
Dim AcroApp As Object
Dim AcroAVDoc As Object
Dim AcroPDDoc As Object
Dim jsObj As Object
Dim ws As Worksheet
Dim searchText As String
Dim pdfName As String
Dim folderPath As String
Dim cell As Range
Dim pdfText As String
Dim pageNum As Integer
Dim wordNum As Integer

On Error GoTo ErrorHandler

' Set the worksheet and search range
Set ws = ThisWorkbook.Sheets("APUpload") ' Change to your sheet name

' Set the folder path to the desktop
folderPath = Environ("USERPROFILE") & "\Desktop\" ' Path to the desktop

' Create Acrobat application object
Set AcroApp = CreateObject("AcroExch.App")
Set AcroAVDoc = AcroApp.GetActiveDoc

' Check if there is an active PDF document
If Not AcroAVDoc Is Nothing Then
Set AcroPDDoc = AcroAVDoc.GetPDDoc
Set jsObj = AcroPDDoc.GetJSObject

' Loop through each cell in column G to find the text in the PDF
For Each cell In ws.Range("G1:G100") ' Adjust the range as needed
searchText = cell.Value
Debug.Print "Search Text: " & searchText

' Loop through pages and words to find the search text
For pageNum = 0 To AcroPDDoc.GetNumPages - 1
For wordNum = 0 To jsObj.getPageNumWords(pageNum) - 1
pdfText = jsObj.getPageNthWord(pageNum, wordNum, True)
If pdfText = searchText Then
' Get the PDF name from the cell in column R adjacent to the found text
pdfName = cell.Offset(0, 11).Value & ".pdf" ' Column R is 11 columns to the right of column G
Debug.Print "PDF Name: " & pdfName

' Save the active PDF with the new name
AcroPDDoc.Save 1, folderPath & pdfName
MsgBox "PDF has been saved successfully as " & pdfName
Exit Sub
End If
Next wordNum
Next pageNum
Next cell

MsgBox "Text not found in the PDF."

Else
MsgBox "No active PDF document found."
End If

' Clean up
Set jsObj = Nothing
Set AcroPDDoc = Nothing
Set AcroAVDoc = Nothing
Set AcroApp = Nothing

Exit Sub

ErrorHandler:
MsgBox "An error occurred: " & Err.Description
' Clean up
Set jsObj = Nothing
Set AcroPDDoc = Nothing
Set AcroAVDoc = Nothing
Set AcroApp = Nothing
End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
MatthewBiersay said:
Hello all!
Been trying to figure out this code to do the following:
Save an open pdf file by searching for text within that pdf that matches text in column g, once this match is found it should save the already open pdf file using the adjacent cell in column R. Tried to use co-pilot but pdf won't save:

This is the code below, all help would be appreciated, or alternative ideas. Thank you!

Sub SearchTextInPDFAndSaveToDesktop()
Dim AcroApp As Object
Dim AcroAVDoc As Object
Dim AcroPDDoc As Object
Dim jsObj As Object
Dim ws As Worksheet
Dim searchText As String
Dim pdfName As String
Dim folderPath As String
Dim cell As Range
Dim pdfText As String
Dim pageNum As Integer
Dim wordNum As Integer

On Error GoTo ErrorHandler

' Set the worksheet and search range
Set ws = ThisWorkbook.Sheets("APUpload") ' Change to your sheet name

' Set the folder path to the desktop
folderPath = Environ("USERPROFILE") & "\Desktop\" ' Path to the desktop

' Create Acrobat application object
Set AcroApp = CreateObject("AcroExch.App")
Set AcroAVDoc = AcroApp.GetActiveDoc

' Check if there is an active PDF document
If Not AcroAVDoc Is Nothing Then
Set AcroPDDoc = AcroAVDoc.GetPDDoc
Set jsObj = AcroPDDoc.GetJSObject

' Loop through each cell in column G to find the text in the PDF
For Each cell In ws.Range("G1:G100") ' Adjust the range as needed
searchText = cell.Value
Debug.Print "Search Text: " & searchText

' Loop through pages and words to find the search text
For pageNum = 0 To AcroPDDoc.GetNumPages - 1
For wordNum = 0 To jsObj.getPageNumWords(pageNum) - 1
pdfText = jsObj.getPageNthWord(pageNum, wordNum, True)
If pdfText = searchText Then
' Get the PDF name from the cell in column R adjacent to the found text
pdfName = cell.Offset(0, 11).Value & ".pdf" ' Column R is 11 columns to the right of column G
Debug.Print "PDF Name: " & pdfName

' Save the active PDF with the new name
AcroPDDoc.Save 1, folderPath & pdfName
MsgBox "PDF has been saved successfully as " & pdfName
Exit Sub
End If
Next wordNum
Next pageNum
Next cell

MsgBox "Text not found in the PDF."

Else
MsgBox "No active PDF document found."
End If

' Clean up
Set jsObj = Nothing
Set AcroPDDoc = Nothing
Set AcroAVDoc = Nothing
Set AcroApp = Nothing

Exit Sub

ErrorHandler:
MsgBox "An error occurred: " & Err.Description
' Clean up
Set jsObj = Nothing
Set AcroPDDoc = Nothing
Set AcroAVDoc = Nothing
Set AcroApp = Nothing
End Sub
Click to expand...

An example would be pdf has “0000-00-00” in document, cell g36 has “0000-00-00” and cell r36 has “0000-00-00 - May 10” so the pdf would save as “ 0000-00-00 - May 10”
 
Upvote 0
Hi Matthew,
The issue is caused by how the `getPageNthWord` function in Adobe JavaScript handles words in the PDF; hyphens (-) are not recognized as part of the words. In the following code, instead of a word-by-word comparison, direct string comparison is used, which concatenates all the words on the PDF page into a complete string and then performs a search for the desired text.
VBA Code: 
Option Explicit

Sub SearchTextInPDFAndSaveToDesktop2()
'https://www.mrexcel.com/board/threads/need-help-saving-an-already-open-pdf-file-using-name-from-spreadsheet-through-vba.1267132/

    Dim AcroApp As Object, AcroAVDoc As Object, AcroPDDoc As Object, jsObj As Object
    Dim ws As Worksheet
    Dim searchText As String, pdfName As String, folderPath As String, pdfPageText As String
    Dim cell As Range
    Dim pageNum As Integer, i As Integer

    On Error GoTo ErrorHandler

    ' Set the worksheet and search range
    Set ws = ThisWorkbook.Sheets("APUpload") ' Change to your sheet name

    ' Set the folder path to the desktop
    folderPath = Environ("USERPROFILE") & "\Desktop\" ' Path to the desktop

    ' Create Acrobat application object
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroAVDoc = AcroApp.GetActiveDoc

    ' Check if there is an active PDF document
    If Not AcroAVDoc Is Nothing Then
        Set AcroPDDoc = AcroAVDoc.GetPDDoc
        Set jsObj = AcroPDDoc.GetJSObject

        ' Loop through each cell in column G to find the text in the PDF
        For Each cell In ws.Range("G1:G100") ' Adjust the range as needed
            searchText = cell.Value
            Debug.Print "Search Text: " & searchText

            ' Loop through pages to find the search text
            For pageNum = 0 To AcroPDDoc.GetNumPages - 1
                ' Concatenate all words on the page into a single string
                pdfPageText = ""
                For i = 0 To jsObj.getPageNumWords(pageNum) - 1
                    pdfPageText = pdfPageText & jsObj.getPageNthWord(pageNum, i, True) & " "
                Next i

                ' Check if the search text is found in the concatenated page text
                If InStr(Replace(pdfPageText, " ", ""), Replace(searchText, "-", "")) > 0 Then
                    ' Get the PDF name from the cell in column R adjacent to the found text
                    pdfName = cell.Offset(0, 11).Value & ".pdf" ' Column R is 11 columns to the right of column G
                    Debug.Print "PDF Name: " & pdfName

                    ' Save the active PDF with the new name
                    AcroPDDoc.Save 1, folderPath & pdfName
                    MsgBox "PDF has been saved successfully as " & pdfName
                    Exit Sub
                End If
            Next pageNum
        Next cell

        MsgBox "Text not found in the PDF."

    Else
        MsgBox "No active PDF document found."
    End If

    ' Clean up
    Set jsObj = Nothing
    Set AcroPDDoc = Nothing
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing

    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description
    ' Clean up
    Set jsObj = Nothing
    Set AcroPDDoc = Nothing
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing
End Sub
 
Upvote 0
Sequoyah said:
Hi Matthew,
The issue is caused by how the `getPageNthWord` function in Adobe JavaScript handles words in the PDF; hyphens (-) are not recognized as part of the words. In the following code, instead of a word-by-word comparison, direct string comparison is used, which concatenates all the words on the PDF page into a complete string and then performs a search for the desired text.
VBA Code: 
Option Explicit

Sub SearchTextInPDFAndSaveToDesktop2()
'https://www.mrexcel.com/board/threads/need-help-saving-an-already-open-pdf-file-using-name-from-spreadsheet-through-vba.1267132/

    Dim AcroApp As Object, AcroAVDoc As Object, AcroPDDoc As Object, jsObj As Object
    Dim ws As Worksheet
    Dim searchText As String, pdfName As String, folderPath As String, pdfPageText As String
    Dim cell As Range
    Dim pageNum As Integer, i As Integer

    On Error GoTo ErrorHandler

    ' Set the worksheet and search range
    Set ws = ThisWorkbook.Sheets("APUpload") ' Change to your sheet name

    ' Set the folder path to the desktop
    folderPath = Environ("USERPROFILE") & "\Desktop\" ' Path to the desktop

    ' Create Acrobat application object
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroAVDoc = AcroApp.GetActiveDoc

    ' Check if there is an active PDF document
    If Not AcroAVDoc Is Nothing Then
        Set AcroPDDoc = AcroAVDoc.GetPDDoc
        Set jsObj = AcroPDDoc.GetJSObject

        ' Loop through each cell in column G to find the text in the PDF
        For Each cell In ws.Range("G1:G100") ' Adjust the range as needed
            searchText = cell.Value
            Debug.Print "Search Text: " & searchText

            ' Loop through pages to find the search text
            For pageNum = 0 To AcroPDDoc.GetNumPages - 1
                ' Concatenate all words on the page into a single string
                pdfPageText = ""
                For i = 0 To jsObj.getPageNumWords(pageNum) - 1
                    pdfPageText = pdfPageText & jsObj.getPageNthWord(pageNum, i, True) & " "
                Next i

                ' Check if the search text is found in the concatenated page text
                If InStr(Replace(pdfPageText, " ", ""), Replace(searchText, "-", "")) > 0 Then
                    ' Get the PDF name from the cell in column R adjacent to the found text
                    pdfName = cell.Offset(0, 11).Value & ".pdf" ' Column R is 11 columns to the right of column G
                    Debug.Print "PDF Name: " & pdfName

                    ' Save the active PDF with the new name
                    AcroPDDoc.Save 1, folderPath & pdfName
                    MsgBox "PDF has been saved successfully as " & pdfName
                    Exit Sub
                End If
            Next pageNum
        Next cell

        MsgBox "Text not found in the PDF."

    Else
        MsgBox "No active PDF document found."
    End If

    ' Clean up
    Set jsObj = Nothing
    Set AcroPDDoc = Nothing
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing

    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description
    ' Clean up
    Set jsObj = Nothing
    Set AcroPDDoc = Nothing
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing
End Sub
Click to expand...


Thank you so much for your help! It’s saving with the correct file name now, however the file isn’t showing up in the location where it is saying it is saved.
 
Upvote 0
Hi,
thanks for the feedback, try hardcoding the path:
VBA Code: 
folderPath = "C:\Users\xxxxx\Desktop\" 'Adapt username
 
Upvote 0
You must log in or register to reply here.

Similar threads

Ottsel
  • Question Question
Create & Secure PDFS with Excel
Replies
3
Views
282
John_w
J
M
  • Question Question
Data Transfer from Excel to PowerPoint and getting PDF file of PPT
Replies
1
Views
128
Sequoyah
Sequoyah
H
  • Question Question
Macro: Convert pdf into Excel and extract certain data to put together with file name
Replies
1
Views
3K
HeinrichPaul
H
W
  • Question Question
Help updating VBA code to use wildcard in the file name
Replies
1
Views
82
AlphaFrog
AlphaFrog
U
  • Question Question
VBA Search Functionality Issue with Arabic Supplier Names in Excel Help Needed???
Replies
1
Views
44
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,874
Messages
6,181,511
Members
453,049
Latest member
amirrznjd

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top