PDA

View Full Version : [SOLVED] VBA Code to open a folder when ctrl + right click is pressed



nathandavies
09-13-2017, 07:21 AM
Hi All,
I'm After some help writing some code to complete the following.


If you press CTRL + Right Click on any cell in Column A it will bring up a user form which has 3 buttons. "Open Folder" "Open Latest Drawings" "Cancel". I'm wanting each button to go to a location on our server based on which button is pressed.


1. To go to project folder it will have to look at SERVER\Company (Column C) \Project No (Column A). this will then open that folder location
2. To go to latest Drawings it will have to look at SERVER\Company (Column C) \Project No (Column A)\PDF
3. Unload User form.


Would anyone be able to help or have done something similar that i could maybe try and edit? I have included my workbook with the two columns highlighted and the user form already created for your assistance.

20320


Cheers
ND

Paul_Hossler
09-13-2017, 09:07 AM
You'll have to tie in the subs for the command buttons, but this will open your user form if you ctrl+RC in col A

Code goes into the code module for WIP sheet




Option Explicit

Const BothLeftAndRightKeys = 0 ' Note: Bit-wise AND of LeftKey and RightKey
Const LeftKey = 1
Const RightKey = 2
Const LeftKeyOrRightKey = 3 ' Note: Bit-wise OR of LeftKey and RightKey
Const KEY_MASK As Integer = &HFF80 ' decimal -128
Const VK_LCTRL = &HA2
Const VK_RCTRL = &HA3

' Declaration of GetKeyState API function. This tests the state of a specified key.
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, Columns(1)) Is Nothing Then Exit Sub

If IsControlKeyDown Then
frmProjectOpen.Show
Cancel = True
End If

End Sub


Private Function IsControlKeyDown(Optional LeftOrRightKey As Long = LeftKeyOrRightKey) As Boolean
Dim Res As Long

Select Case LeftOrRightKey
Case LeftKey
Res = GetKeyState(VK_LCTRL) And KEY_MASK
Case RightKey
Res = GetKeyState(VK_RCTRL) And KEY_MASK
Case BothLeftAndRightKeys
Res = (GetKeyState(VK_LCTRL) And GetKeyState(VK_RCTRL) And KEY_MASK)
Case Else
Res = GetKeyState(vbKeyControl) And KEY_MASK
End Select

IsControlKeyDown = CBool(Res)
End Function

mdmackillop
09-13-2017, 09:29 AM
Try this. Right Click in Column A (no Ctrl). The Server path probably need correcting.

Paul_Hossler
09-13-2017, 01:25 PM
Nice

I liked the way you used .Tag to communicate the row number

nathandavies
09-14-2017, 07:44 AM
Thanks mdmackillop (http://www.vbaexpress.com/forum/member.php?87-mdmackillop) & Paul_Hossler (http://www.vbaexpress.com/forum/member.php?9803-Paul_Hossler)!

I've updated the code, with my server details but i keep getting an error and i think i know why our folder structure uses the project name in folder as well as the project number ie. P1234 John Smith Road

I keep getting an error code at this bit of the code

ChDir Pth

The code updated

Const kServerRootPattern = "\\NEWBENSON\Projects\Drawings\"Dim strJobNo As String
Dim strJobCom As String




Private Sub cmdFolder_Click()
Dim Pth As String
rw = Me.Tag
Pth = "\\NEWBENSON\Projects\Drawings\" & Cells(rw, 3) & "\" & Cells(rw, 1) & "\"
Call openDialog(Pth, "All")
End Sub


Private Sub cmdDrawings_Click()
Dim Pth As String
rw = Me.Tag
Pth = "\\NEWBENSON\Projects\Drawings\" & Cells(rw, 3) & "\" & Cells(rw, 1) & "\"
Call openDialog(Pth, "pdf")
End Sub


Private Sub openDialog(Pth, Flt)
Dim fd As Office.FileDialog
ChDir Pth
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please select the file."
' Clear out the current filters, and add our own.
.Filters.Clear
'.Filters.Add "Excel 2003", "*.xls"
Select Case Flt
Case "All"
.Filters.Add "All Files", "*.*"
Case "pdf"
.Filters.Add "PDF Files", "*.pdf"
End Select


' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
txtFileName = .SelectedItems(1) 'replace txtFileName with your textbox
End If
End With
End Sub

mdmackillop
09-14-2017, 07:57 AM
Browse to your file location in File Explorer, click in the address box for the path name or use "MsgBox ActiveWorkbook.path" from a file in that location to confirm the correct folder address.

Paul_Hossler
09-14-2017, 08:06 AM
1. What error message?


2. There's a limit (I think 260 char) for max path length

Is you total path longer that that?

https://mspoweruser.com/ntfs-260-character-windows-10/


3. Are you SURE that the path exists?

nathandavies
09-14-2017, 08:06 AM
I'm not sure what you mean, this is the correct folder path for the top row on the attached example workbook

\\SERVER\Projects\Drawings\Company\P1711 Liverpool Street Station

nathandavies
09-14-2017, 08:11 AM
It my error! I have explained it incorrectly!

The folder name is a combination of Column A & B not just Column A

Apologies!

mdmackillop
09-14-2017, 08:18 AM
There is an error here in both button codes
Pth = "\\NEWBENSON\Projects\Drawings\" & Cells(rw, 3) & "\" & Cells(rw, 1) & "\"
which should read
Pth = "\\NEWBENSON\Projects\Drawings\" & Cells(rw, 3) & "\" & Cells(rw, 1) & " " & Cells(rw, 2) & "\"

EDIT: You can use "Debug.Print Pth" to inspect the result in the immediate window.

nathandavies
09-14-2017, 08:42 AM
This works in the first instance but if you go to another row to go to a different folder i remembers the folder you was last in

Edit: Also when i'm in the folder, if i click on a file to open it does nothing.

snb
09-14-2017, 08:51 AM
Private Sub cmdFolder_Click()
with application.filedialog(1)
.intialfilename="\\NEWBENSON\Projects\Drawings\" & Cells(tag, 3) & "\" & Cells(tag, 1) & " " & Cells(tag, 2) & "\*.txt"
if .show then workbooks.open .selecteditems(1)
end with
End Sub

nathandavies
09-14-2017, 08:58 AM
snb, that seems to error on
With application.filedialog(1)

snb
09-15-2017, 12:31 AM
check the spelling
Use F1 in the VBEditor

nathandavies
09-15-2017, 02:48 AM
SNB, this is working on right click but it only opens "my Documents" it does not use the cells for the path.

any ideas?

snb
09-15-2017, 03:35 AM
than refer in the code to the sheet the cells are in:


sheets("abc").cells(tag,1)

mdmackillop
09-15-2017, 09:16 AM
This works in the first instance but if you go to another row to go to a different folder i remembers the folder you was last in
I cannot see a reason for this. ChDir does not make the required change.
As a workaround, this will open file explorer to the correct folder, but there is no file type filter


Private Sub cmdFolder_Click()
Dim Pth As String
rw = Me.Tag
Pth = "\\NEWBENSON\Projects\Drawings\" & Cells(rw, 3) & "\" & Cells(rw, 1) & " " & Cells(rw, 2) & "\"
Call Shell("explorer.exe" & " " & Pth, vbNormalFocus)
End Sub
If FilePicker solution can be found then to open files of any type

If .Show = True Then ActiveWorkbook.FollowHyperlink (.SelectedItems(1)), NewWindow:=True

nathandavies
09-18-2017, 01:55 AM
mdmackillop, that now work perfectly. just another quick one? is there a way to close the userform automatically after it has opened a folder ?

mdmackillop
09-18-2017, 03:08 AM
Add at the end of the button code. This will close the Userform as File Explorer opens. Triggering it from selecting a file is more problematical.

Unload Me

nathandavies
09-18-2017, 05:31 AM
excellent thank you very much!!

rep added!