求助：修改同文件夹下合并数据代码

yejifenghan

一个文件夹下多个同格式表，汇总每张表的某一行到一个花名册里，但是想在汇总的数据后添加所汇总数据来源文件的超链接（hyperlink）。求高手修改代码。
Page
Sub all_libubai()  'by libubai
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim cnn As Object, rs As Object, sql$, mypath$, myfile$
    Set cnn = CreateObject("Adodb.Connection")
    Set rs = CreateObject("adodb.recordset")
    If Application.Version * 1 <= 11 Then
        cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties='Excel 8.0;imex=1;hdr=no';Data Source=" & ThisWorkbook.FullName
    Else
        cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;imex=1;hdr=no';Data Source=" & ThisWorkbook.FullName
    End If
    mypath = ThisWorkbook.Path & "\"
    myfile = Dir(mypath & "*.xls*")
    Range("a2:ae65536").ClearContents
    Do While myfile <> ""
        If myfile <> ThisWorkbook.Name Then
            sql = "select * from [Excel 8.0;imex=1;hdr=no;Database=" & mypath & myfile & "].[汇总册$A2:AE2]"
            Set rs = cnn.Execute(sql)
            Range("a65536").End(3).Offset(1).CopyFromRecordset rs
        End If
        myfile = Dir
    Loop
    rs.Close
    Set rs = Nothing
    Set cnn = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "项目管理人员信息已汇总完成，请查看！", 64, "操作提示"
End Sub
Page
上述代码只完成了汇总工作，如何在AF列添加各自行所引用的文件的超链接呢？

tmtony

超链接可以把工作簿的路径写到单元格中
mypath

yejifenghan

tmtony 发表于 2016-1-21 15:03
超链接可以把工作簿的路径写到单元格中
mypath

这样文件复制转移后，如果不打开，可以动态更新链接吗
来自: 微社区

roych

yejifenghan 发表于 2016-1-21 15:06
这样文件复制转移后，如果不打开，可以动态更新链接吗

文件转移之后，怎么通知电脑？

access新新新手

yejifenghan 发表于 2016-1-21 15:06
这样文件复制转移后，如果不打开，可以动态更新链接吗

超链接代码
Sub 超链接()
   Dim MyPath$, MyFile$, k
   MyPath = ThisWorkbook.Path & "\"
  MyFile = Dir(MyPath, vbDirectory)
  Do
    If MyFile <> "" And Len(Replace(MyFile, ".", "")) <> 0 Then
        k = k + 1
        Sheet1.Hyperlinks.Add Cells(k, 32), ThisWorkbook.Path & "\" & MyFile, , , MyFile
    End If
    MyFile = Dir
  Loop While MyFile <> ""
  Sheet1.Range("af1").Clear
  Sheet1.Range("af1") = "超链接"
End Sub

yejifenghan

access新新新手 发表于 2016-1-21 17:31
超链接代码
Sub 超链接()
   Dim MyPath$, MyFile$, k

谢谢，我主要是想合并，大神你会改吗。？
来自: 微社区