VBA之自动建立连接

                        

     马上公司就要进行CMMI评估了，所以需要现在将PIID表和实际项目及过程相关文件建立连接，以方便评估时进行证据的查找。每一个PA的每个SP,GP对应的每个项目都至少需要一个直接证据和一个间接证据，这可苦了我们这些ATM人员了，为了能够减少点负担，所以写了这个宏，让其能根据所单击的单元格，自动定位到相应的项目的目录，然后ATM人员根据情况进行选择文件或者目录，具体宏的内容如下：

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call SelectFile(Target)
End Sub
Sub SelectFile(ByVal Target As Range)
    Dim strURL As String
    Dim strCol As String
    strURL = "\\192.168.2.10\cmmi3\"
    If Target.Cells.Count = 1 Then
        If UCase(Target.Value) = "X" Then
            If Target.Hyperlinks.Count = 1 Then
                strURL = Target.Hyperlinks.Item(1).Address
            Else
                strCol = Right(Left(Target.Address, 2), 1)
                Select Case strCol
                    Case "H"
                        strURL = strURL + "EPG\XXX_CMMI_DEFINITION\"
                    Case "I"
                        strURL = strURL + "Project1\"
                    Case "J"
                        strURL = strURL + "Project2\"
                    Case "K"
                        strURL = strURL + "Project3\"
                    Case "L"
                        strURL = strURL + "Project4\"
                    Case Else
                        Exit Sub
                End Select
            End If
            With Application.FileDialog(msoFileDialogFilePicker)
                .InitialFileName = strURL
                If .Show = True Then
                    'MsgBox .SelectedItems(1)
                    Target.Hyperlinks.Add(Anchor:=Selection, Address:=.SelectedItems(1), TextToDisplay:="X")
                    Exit Sub
                End If
            End With
            'Select folder
            With Application.FileDialog(msoFileDialogFolderPicker)
                .InitialFileName = strURL
                If .Show = True Then
                    Target.Hyperlinks.Add(Anchor:=Selection, Address:=.SelectedItems(1), TextToDisplay:="X")
                    Exit Sub
                End If
            End With
            'Input link by manual
            If Target.Hyperlinks.Count = 1 Then
                strURL = InputBox("Please input link address:", "Input", strURL)
            Else
                strURL = InputBox("Please input link address:", "Input", "http://planner.jfsys.com:8080/xplanner2/do/view/projects")
            End If
            If Len(strURL) > 0 Then
                Target.Hyperlinks.Add(Anchor:=Selection, Address:=strURL, TextToDisplay:="X")
            End If
        End If
    End If
End Sub

当然其中有部分是常量，大家可以根据需要修改。（版权所有，转载请注明出处！http://lazybee.cnblogs.com/）