Office中国论坛/Access中国论坛

标题: 求助：修改同文件夹下合并数据代码 [打印本页]

作者: yejifenghan 时间: 2016-1-21 14:45
标题: 求助：修改同文件夹下合并数据代码
一个文件夹下多个同格式表，汇总每张表的某一行到一个花名册里，但是想在汇总的数据后添加所汇总数据来源文件的超链接（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 时间: 2016-1-21 15:03
超链接可以把工作簿的路径写到单元格中
mypath

作者: yejifenghan 时间: 2016-1-21 15:06

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

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

作者: roych 时间: 2016-1-21 16:20

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

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

作者: access新新新手 时间: 2016-1-21 17:31

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 时间: 2016-1-21 18:04

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

谢谢，我主要是想合并，大神你会改吗。？

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)