Open PDF Files based on any input data.

T

tienanh2910

New Member
Joined
Apr 20, 2023
Messages
3
Office Version
  1. 2016
Hello together,

I want to create a VBA code can help me to open PDF files based on any input data.

My Excel file like below:
1682051123407.png


My wish is when I put the name in A3 (For example: A0105601, I can open exactly the pdf file in my folder "C:\Users\PA02400431\Desktop\New folder".

1682051378124.png


Thank you all for your support in advance!

I hope to hearing from you soon.
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Sort by date Sort by votes
paste the NativeApp code into a module, then you can open any file with it using: OpenNativeFile vFile

BUTTON CLICK code:
Code: 
sub btnOpen_click()
dim vName, vFile
const kDIR = "\\server\folder\"

vName = range("a3").value
if instr(vName,".pdf")=0 then vName = vName & ".pdf"
vFile = kdir & vName

OpenNativeFile  vFile

end sub



Paste this part into a module

Code: 
#If Win64 Then      'Public Dclare PtrSafe Function
  Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
  Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
#else
  Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
  Private Declare Function GetDesktopWindow Lib "user32" () As Long
#End If


Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&


Public Sub OpenNativeApp(ByVal psDocName As String)
Dim r As Long, msg As String

r = StartDoc(psDocName)
If r <= 32 Then
    'There was an error
    Select Case r
        Case SE_ERR_FNF
            msg = "File not found"
        Case SE_ERR_PNF
            msg = "Path not found"
        Case SE_ERR_ACCESSDENIED
            msg = "Access denied"
        Case SE_ERR_OOM
            msg = "Out of memory"
        Case SE_ERR_DLLNOTFOUND
            msg = "DLL not found"
        Case SE_ERR_SHARE
            msg = "A sharing violation occurred"
        Case SE_ERR_ASSOCINCOMPLETE
            msg = "Incomplete or invalid file association"
        Case SE_ERR_DDETIMEOUT
            msg = "DDE Time out"
        Case SE_ERR_DDEFAIL
            msg = "DDE transaction failed"
        Case SE_ERR_DDEBUSY
            msg = "DDE busy"
        Case SE_ERR_NOASSOC
            msg = "No association for file extension"
        Case ERROR_BAD_FORMAT
            msg = "Invalid EXE file or error in EXE image"
        Case Else
            msg = "Unknown error"
    End Select
'    MsgBox msg
End If
End Sub


Private Function StartDoc(psDocName As String) As Long
Dim Scr_hDC As Long

Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", psDocName, "", "C:\", SW_SHOWNORMAL)
End Function
 
Upvote 1
This workbook (HERE) does what you asked for. You'll have to change as many as three lines of the code as shown with <= in comments.

VBA Code: 
Option Explicit

Sub OpenPDF()

'   Variant used to open the PDF file.
    Dim vReturnFile As Variant
   
'   Location (path or folder) and filename for the Acrobat reader.
    Dim sPDFReaderFileSpec As String
   
'   Location (path or folder) containg the PDF file to open.
    Dim sPDFFileFolder As String

'   Name of the PDF file to open.
    Dim sPDFFileName As String
   
'   Location (path or folder) and filename for the PDF file to open.
    Dim sPDFFileSpec As String
   
'   Set path or folder to and name of the PDF reader file.
'   This must be the location and name of the PDF reader ON YOUR COMPUTER.
'   It MAY be the same on your computer.
    sPDFReaderFileSpec = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" '<= change this

'   Where (in what path or folder) is the PDF file to open located?
    sPDFFileFolder = ThisWorkbook.Path & "\" '<= change this to path/folder on your PC.
   
'   Set name of the PDF file to open. Look for the name in the cell C3 in active worksheet.
    sPDFFileName = ActiveSheet.Range("A3").Value  '<= change this if the input cell changes.

'   Make sure that the file name includes the .pdf part.
    If Right(sPDFFileName, 4) <> ".pdf" _
     Then sPDFFileName = sPDFFileName & ".pdf"
   
'   Set location (path or folder) and filename for the PDF file to open.
    sPDFFileSpec = sPDFFileFolder & sPDFFileName
   
    If Dir(sPDFFileSpec) = "" _
     Then
        MsgBox " The PDF file named " & sPDFFileName & " was not found.", vbExclamation
        Exit Sub
    End If
   
    vReturnFile = Shell(sPDFReaderFileSpec & " " & sPDFFileSpec, vbNormalFocus)

End Sub
 
Upvote 1
ranman256 said:
paste the NativeApp code into a module, then you can open any file with it using: OpenNativeFile vFile

BUTTON CLICK code:
Code: 
sub btnOpen_click()
dim vName, vFile
const kDIR = "\\server\folder\"

vName = range("a3").value
if instr(vName,".pdf")=0 then vName = vName & ".pdf"
vFile = kdir & vName

OpenNativeFile  vFile

end sub



Paste this part into a module

Code: 
#If Win64 Then      'Public Dclare PtrSafe Function
  Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
  Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
#else
  Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
  Private Declare Function GetDesktopWindow Lib "user32" () As Long
#End If


Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&


Public Sub OpenNativeApp(ByVal psDocName As String)
Dim r As Long, msg As String

r = StartDoc(psDocName)
If r <= 32 Then
    'There was an error
    Select Case r
        Case SE_ERR_FNF
            msg = "File not found"
        Case SE_ERR_PNF
            msg = "Path not found"
        Case SE_ERR_ACCESSDENIED
            msg = "Access denied"
        Case SE_ERR_OOM
            msg = "Out of memory"
        Case SE_ERR_DLLNOTFOUND
            msg = "DLL not found"
        Case SE_ERR_SHARE
            msg = "A sharing violation occurred"
        Case SE_ERR_ASSOCINCOMPLETE
            msg = "Incomplete or invalid file association"
        Case SE_ERR_DDETIMEOUT
            msg = "DDE Time out"
        Case SE_ERR_DDEFAIL
            msg = "DDE transaction failed"
        Case SE_ERR_DDEBUSY
            msg = "DDE busy"
        Case SE_ERR_NOASSOC
            msg = "No association for file extension"
        Case ERROR_BAD_FORMAT
            msg = "Invalid EXE file or error in EXE image"
        Case Else
            msg = "Unknown error"
    End Select
'    MsgBox msg
End If
End Sub


Private Function StartDoc(psDocName As String) As Long
Dim Scr_hDC As Long

Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", psDocName, "", "C:\", SW_SHOWNORMAL)
End Function
Click to expand...
Thanks for your strong support!
 
Upvote 0
OaklandJim said:
This workbook (HERE) does what you asked for. You'll have to change as many as three lines of the code as shown with <= in comments.

VBA Code: 
Option Explicit

Sub OpenPDF()

'   Variant used to open the PDF file.
    Dim vReturnFile As Variant
  
'   Location (path or folder) and filename for the Acrobat reader.
    Dim sPDFReaderFileSpec As String
  
'   Location (path or folder) containg the PDF file to open.
    Dim sPDFFileFolder As String

'   Name of the PDF file to open.
    Dim sPDFFileName As String
  
'   Location (path or folder) and filename for the PDF file to open.
    Dim sPDFFileSpec As String
  
'   Set path or folder to and name of the PDF reader file.
'   This must be the location and name of the PDF reader ON YOUR COMPUTER.
'   It MAY be the same on your computer.
    sPDFReaderFileSpec = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" '<= change this

'   Where (in what path or folder) is the PDF file to open located?
    sPDFFileFolder = ThisWorkbook.Path & "\" '<= change this to path/folder on your PC.
  
'   Set name of the PDF file to open. Look for the name in the cell C3 in active worksheet.
    sPDFFileName = ActiveSheet.Range("A3").Value  '<= change this if the input cell changes.

'   Make sure that the file name includes the .pdf part.
    If Right(sPDFFileName, 4) <> ".pdf" _
     Then sPDFFileName = sPDFFileName & ".pdf"
  
'   Set location (path or folder) and filename for the PDF file to open.
    sPDFFileSpec = sPDFFileFolder & sPDFFileName
  
    If Dir(sPDFFileSpec) = "" _
     Then
        MsgBox " The PDF file named " & sPDFFileName & " was not found.", vbExclamation
        Exit Sub
    End If
  
    vReturnFile = Shell(sPDFReaderFileSpec & " " & sPDFFileSpec, vbNormalFocus)

End Sub
Click to expand...
Hello,

It's working. Thank you!
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Open Outlook
Replies
1
Views
160
Trevor G
Trevor G
M
  • Solved
PDF's won't open in Sharepoint/Teams but will in C:drive Documents folder
Replies
3
Views
710
Mr_Ragweed2
M
O
  • Solved
Why I cannot use the wildcard while opening a pdf file?
Replies
7
Views
160
Ongbey
O
Z
  • Question
Print-to-PDF is corrupted in WIN11
Replies
1
Views
130
zombiemaster
Z
I
  • Solved
Add date to pdf output
Replies
5
Views
105
Joe4
Joe4

Forum statistics

Threads
1,215,326
Messages
6,124,258
Members
449,149
Latest member
mwdbActuary

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