VBA - Open PDF file

[hrayani]

Hello All,

How can we open this pdf file with VBA macro.


C:\Users\i ' M\Desktop\PDF\test file 123-234.pdf

Any help would be appreciated

Regards,

Humayun

 

[DanteAmor]

Try:

Sub test()    ActiveWorkbook.FollowHyperlink "C:\Users\i ' M\Desktop\PDF\test file 123-234.pdf"
 End Sub

 

[hrayani]

Thanks DanteAmor for the reply

I will try the solution you provided and will get back to you on Monday as before that I won’t be having access to my computer. I will keep you posted

Regards,

Humayun

 

[hrayani]

Hi Dante,

I tried your code and its working PERFECT.

I modified the code a bit to suit my needs.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)      
            Dim fName As String
            fName = "C:\Users\i ' M\Desktop\PDF\" & Selection.Value & ".pdf" 


    lrB = Cells(Rows.Count, "B").End(xlUp).Row


    If Not Intersect(Target, Range("B4:B" & lrB)) Is Nothing Then
    
    ActiveWorkbook.FollowHyperlink fName 
   
End If


End Sub

Just 2 Issues

1) I get a system message that the file I am trying to open might not be safe. I want to get rid of this message. I tried application.displayalerts=false but its still giving the message.

2) When a file is not found - I would want a msgbox to appear stating that "File Not Found" instead of debug message (run time error)

Regards,

Humayun

 

[DanteAmor]

Just 2 Issues

1) I get a system message that the file I am trying to open might not be safe. I want to get rid of this message. I tried application.displayalerts=false but its still giving the message.

I'm not sure if it's a Trust Center Settings option or a message from your antivirus.

2) When a file is not found - I would want a msgbox to appear stating that "File Not Found" instead of debug message (run time error)

Regards,

Humayun

Try this

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim fName As String, lrB As Long
  Cancel = True
  fName = "C:\Users\i ' M\Desktop\PDF\" & Selection.Value & ".pdf"
  lrB = Cells(Rows.Count, "B").End(xlUp).Row
[COLOR=#008000]  If Dir(fName) <> "" Then[/COLOR]
    If Not Intersect(Target, Range("B4:B" & lrB)) Is Nothing Then
      ActiveWorkbook.FollowHyperlink fName
    End If
  Else
    MsgBox "File Not Found"
  End If
End Sub

 

[hrayani]

Hi Dante,

Sorry for coming back late.

Very near to the solution - I guess. Actually I am using this BeforeDoubleClick procedure for two things

Here is the full code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)  
    Application.Calculation = xlCalculationAutomatic
    
    Dim lrA As Long
    lrA = Cells(Rows.Count, "A").End(xlUp).Row


 If Not Intersect(Target, Range("A4:A" & lrA)) Is Nothing Then
   
   Sheets("RUNNING ORDER STATUS").Unprotect Password:="merchant"
   
   Sheets("CURRENT PRODUCTION STATUS").Visible = True
   Sheets("CURRENT PRODUCTION STATUS").Select
   
   Sheets("RUNNING ORDER STATUS").Select
   Selection.copy
   
   Sheets("CURRENT PRODUCTION STATUS").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
   Sheets("RUNNING ORDER STATUS").Visible = False
   
     Sheets("RUNNING ORDER STATUS").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True _
        , Password:="merchant"
 
 Application.Calculation = xlCalculationAutomatic


End If




[COLOR=#008000]  Dim fName As String[/COLOR]
[COLOR=#008000]  Dim lrB As Long[/COLOR]
[COLOR=#008000]  [/COLOR]
[COLOR=#008000]  Cancel = True[/COLOR]
[COLOR=#008000]  [/COLOR]
[COLOR=#008000]  fName = "C:\Users\i ' M\Desktop\PDF\" & Selection.Value & ".pdf"[/COLOR]
[COLOR=#008000]  [/COLOR]
[COLOR=#008000]  lrB = Cells(Rows.Count, "B").End(xlUp).Row[/COLOR]
[COLOR=#008000]  If Dir(fName) <> "" Then[/COLOR]
[COLOR=#008000]    [/COLOR]
[COLOR=#008000]    If Not Intersect(Target, Range("B4:B" & lrB)) Is Nothing Then[/COLOR]
[COLOR=#008000]      [/COLOR]
[COLOR=#008000]      SendKeys "{TAB}"  ' [/COLOR][COLOR=#ff0000]I have added these keys to overcome the system message issue[/COLOR][COLOR=#008000][/COLOR]
[COLOR=#008000]      SendKeys "{ENTER}" [/COLOR]
[COLOR=#008000]      [/COLOR]
[COLOR=#008000]      ActiveWorkbook.FollowHyperlink fName[/COLOR]
[COLOR=#008000]      [/COLOR]
[COLOR=#008000]    End If[/COLOR]
[COLOR=#008000]  Else[/COLOR]
[COLOR=#008000]    MsgBox "File Not Found"[/COLOR]
[COLOR=#008000]  End If[/COLOR]


End Sub

The problem is that I get the msgbox whenever I click any cell on the sheet. Whereas I would want the msgbox to appear only when a cell is clicked in Column B and the file is not found. I get the msgbox even if the upper part of the code is running which is linked with Column A.

Regards,

Humayun

 

[DanteAmor]

Try this

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim lrA As Long
  lrA = Cells(Rows.Count, "A").End(xlUp).Row
  If Not Intersect(Target, Range("A4:A" & lrA)) Is Nothing Then
    Application.Calculation = xlCalculationAutomatic
    Sheets("RUNNING ORDER STATUS").Unprotect Password:="merchant"
    Sheets("CURRENT PRODUCTION STATUS").Visible = True
    Sheets("CURRENT PRODUCTION STATUS").Select
    Sheets("RUNNING ORDER STATUS").Select
    Selection.Copy
    Sheets("CURRENT PRODUCTION STATUS").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Sheets("RUNNING ORDER STATUS").Visible = False
    Sheets("RUNNING ORDER STATUS").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
      AllowFormattingColumns:=True, AllowFormattingRows:=True, Password:="merchant"
    Application.Calculation = xlCalculationAutomatic
  End If
  '
  Dim fName As String, lrB As Long
  lrB = Cells(Rows.Count, "B").End(xlUp).Row
  If Not Intersect(Target, Range("B4:B" & lrB)) Is Nothing Then
    If Target.Value = "" Then Exit Sub
    Cancel = True
    fName = "C:\Users\i ' M\Desktop\PDF\" & Target.Value & ".pdf"
    If Dir(fName) <> "" Then
      SendKeys "{TAB}"  ' I have added these keys to overcome the system message issue
      SendKeys "{ENTER}"
      ActiveWorkbook.FollowHyperlink fName
    End If
  Else
    MsgBox "File Not Found"
  End If
End Sub

 

[hrayani]

Hi Dante,

Its working totally opposite.

Its giving file not found on all columns except column B and also when the upper part of the code is running.

I want msgbox to be only displayed if a cell in column B is clicked and there is no file with that name

Regards,

 

[DanteAmor]

Ooops
Try with this

Dim fName As String, lrB As Long
  lrB = Cells(Rows.Count, "B").End(xlUp).Row
  If Not Intersect(Target, Range("B4:B" & lrB)) Is Nothing Then
    If Target.Value = "" Then Exit Sub
    Cancel = True
    fName = "C:\Users\i ' M\Desktop\PDF\" & Target.Value & ".pdf"
    If Dir(fName) <> "" Then
      SendKeys "{TAB}"  ' I have added these keys to overcome the system message issue
      SendKeys "{ENTER}"
      ActiveWorkbook.FollowHyperlink fName
   
  Else
    MsgBox "File Not Found"
  End If
End if

 

[hrayani]

Hi Dante

Thanks a lot.. works great