我不知道是否有人也許能幫助我請。VBA打開文件從超鏈接
隨着沿途一些幫助,我使用下面的代碼來執行以下操作:從給定路徑
- 解壓文件,
- 插入文件名到C列,
- 文件路徑爲柱d,和
在列A上的每一行的超鏈接乙,其用戶選擇他們去到「另存爲對話框」允許用戶保存文件。
Public Sub ListFilesInFolder(SourceFolder As Scripting.folder, IncludeSubfolders As Boolean) Dim fName As String Dim Lastrow As Long On Error Resume Next For Each FileItem In SourceFolder.Files ' display file properties Cells(iRow, 3).Formula = FileItem.Name Cells(iRow, 4).Formula = FileItem.Path iRow = iRow + 1 ' next row number '''''''' '' As the progress bar is set for 0 to 100, treat '' the progress as a percentage when calculating '''''''' frm.prgStatus.Value = (xCur/xMax) * 100 '' Add 1 to xCur ready for next file xCur = xCur + 1 Next FileItem Range("C10").CurrentRegion.Select Selection.Sort Key1:=Range("C10"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal With ActiveSheet Lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row Lastrow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End With If IncludeSubfolders Then For Each SubFolder In SourceFolder.SubFolders ListFilesInFolder SubFolder, True Next SubFolder End If Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing For iRow = 10 To Lastrow Cells(iRow, 2).Formula = iRow - 9 Cells(iRow, 4).Formula = FileItem.Path ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRow, 2), Address:="", _ ScreenTip:=CStr(iRow - 9) Next End Sub
當超鏈接的用戶點擊,這是「跟隨超鏈接」代碼運行,允許用戶保存文件。
*****更新的代碼*****
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim FSO
Dim sFile As String
Dim sDFolder As String
Dim thiswb As Workbook ', wb As Workbook
On Error GoTo CleanExit:
'Disable events so the user doesn't see the codes selection
Application.EnableEvents = False
'Define workbooks so we don't lose scope while selecting sFile(thisworkbook = workbook were the code is located).
Set thiswb = ThisWorkbook
'Set wb = ActiveWorkbook ' This line was commented out because we no longer need to cope with 2 excel workbooks open at the same time.
'Target.Range.Value is the selection of the Hyperlink Path. Due to the address of the Hyperlink being "" we just assign the value to a
'temporary variable which is not used so the Click on event is still triggers
temp = Target.Range.Value
'Activate the wb, and attribute the File.Path located 1 column left of the Hyperlink/ActiveCell
thiswb.Activate
sFile = Cells(ActiveCell.Row, ActiveCell.Column + 2).Value
If UCase$(Mid$(sFile, InStrRev(sFile, ".") + 1)) = "DOCX" Then
Application.EnableEvents = True
Select Case MsgBox("Do you wish to view the file before saving?", vbYesNoCancel Or vbQuestion, "Save or View?")
Case vbCancel: Exit Sub
Case vbYes:
With CreateObject("Word.Application")
.Visible = True
.Documents.Open sFile
.Activate
End With
Exit Sub
End Select
End If
'Declare a variable as a FileDialog Object
Dim fldr As FileDialog
'Create a FileDialog object as a File Picker dialog box.
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
'Allow only single selection on Folders
fldr.AllowMultiSelect = False
'Show Folder picker dialog box to user and wait for user action
fldr.Show
'Did the user cancel?
If fldr.SelectedItems.Count > 0 Then
'Add the end slash of the path selected in the dialog box for the copy operation
sDFolder = fldr.SelectedItems(1) & "\"
'FSO System object to copy the file
Set FSO = CreateObject("Scripting.FileSystemObject")
' Copy File from (source = sFile), destination , (Overwrite True = replace file with the same name)
FSO.CopyFile (sFile), sDFolder, True
MsgBox "File Saved!"
Else
'Do anything you need to do if you didn't get a filename.
MsgBox "You choose not to save the file!"
End If
' Check if there's multiple excel workbooks open and close workbook that is not needed
' section commented out because the Hyperlinks no longer Open the selected file
' If Not thiswb.Name = wb.Name Then
' wb.Close
' End If
CleanExit:
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
End If
Application.EnableEvents = True
End Sub
的代碼工作正常,但我正在尋找改變這種一點點,我到目前爲止已經試過了沒有工作。
我想要做的是在列d解壓文件擴展名,從路徑改變這一點,如果擴展的.docx,我希望用戶能夠查看該文件,而而不是直接進入「另存爲對話框」。
我有點出我的深度和我說,我所做的更改都沒有奏效。
我只是想知道一個人是否有可能有一個看看這個,請,並提供對我怎麼可能去實現這一些指導。
許多的感謝和親切的問候
克里斯
你爲什麼不寫代碼,只是保存與每個文件你想要的文件名而不是讓某人手動完成它? –
你好@TobyAllen,非常感謝你花時間回覆我的帖子。允許用戶手動保存文件的想法是,他們可以在本地計算機上瀏覽想說的文件夾。親切的問候。 – IRHM