[已解决]如何添加附件而不是仅仅是超链接

toddbckele · 发表于 2015-6-8 13:43

我有如下的附件在地N列里面我添加的是超链接，如果把文件给拷贝走了那么就能打开，不知道可不可以不管什么时候都能打开文件。vba代码该如何修改。PS：我们主要是实用myexcel 系统需要把证书更新到数据库当中现在这样的情况更新到数据库的只是文件名而不是附件。

最佳答案

月排行榜 / 总排行榜

roych

2015-6-9 15:34

toddbckele 发表于 2015-6-8 18:28
最后行号 = Sheets("sheet5").Range("T65536").End(xlUp).Row

Dim sErr As String '定义接口变 ...

如何更新数据库我并不关心。我只知道，Excel不支持OLE长二进制数据。如果非要导入到其它数据库（例如SQL Server、Access等等），请不要在Excel里处理。
——除非数据库保存的是路径。不过，话又说回来，如果路径相对固定的话，根本不必要去保存路径。
当然，你也可以使用图片格式来保存。但是强制放在一个单元格内，好看吗？
如果需要上传什么的，完全可以用FileCopy来完成文件的复制。
给的这段代码我已经看了。

我想说的是，即便封装了其它自定义的类库，能够起到优化程序或者界面的作用，如果没有提供API示例，完全不必要去引用。就这段代码而言，除了免去逐个去引用库之外，我并不觉得用这个插件有什么优势。事实上，如果你了解引用内置库的好处，估计就不会去引用这些库了：

绝大部分情况下，分发到客户端时，内置库不会丢失。——第三方的就难说了。
内置库在帮助文件或网络上有相对完整的API接口程序示例。
学习一个内置库，可以熟悉同一类的编程。例如Dim fso As New FileSystemObject在JavaScript中可以改为：CreateActiveXObject("Scripting.FileSystemObject")来使用（当然，前提是使用IE浏览器）。——如果改为其它库，可以吗？别的不说，你怎么引用这个库还是个问题。

你完全可以引用Microsoft Scripting runtime库来完成这部分操作。大体是：
Dim fso As New FileSystemObject
dim fl as File
fso.GetFold(你的路径)'获取文件夹路径。还可以加上files/subfolds集合获取文件夹下的文件/子文件夹。具体请参考以下帖子：
http://www.excelpx.com/forum.php?mod=viewthread&tid=365551

跳转到最佳答案楼层

roych · 发表于 2015-6-8 15:36

Sub test()
Sheet1.OLEObjects.Add Filename:= _
      "C:\Users\Administrator\Desktop\刷单已审核.xlsx", Link:=False, DisplayAsIcon:= _
      True, IconFileName:= _
      "C:\Windows\Installer\{90140000-0011-0000-0000-0000000FF1CE}\xlicons.exe", _
      IconIndex:=0, IconLabel:="刷单审核"
End Sub
这里以Excel为例。
注意，不同的文件类型，如果显示为图标，类库应该是不一样的。即需要修改红色那部分：
C:\Windows\Installer\{90140000-0011-0000-0000-0000000FF1CE}\xlicons.exe
建议最好录制一下。

toddbckele · 发表于 2015-6-8 15:50

roych 发表于 2015-6-8 15:36
Sub test()
Sheet1.OLEObjects.Add Filename:= _
"C:\Users\Administrator\Desktop\刷单已审核.x ...

这样做我不能做到全部提取呀只能单个的提取。那样也不太好，太慢了呢。。不知道有没有其他办法可以看看我的代码。求大神帮忙一下~~！！

roych · 发表于 2015-6-8 17:01

toddbckele 发表于 2015-6-8 15:50
这样做我不能做到全部提取呀只能单个的提取。那样也不太好，太慢了呢。。不知道有没有其他办法可以看看 ...

修改为：
Sheets(1).OLEObjects.Add Filename:=dir_name & strfilename, Link:=False, _
DisplayAsIcon:=True, IconFileName:="C:\Windows\system32\packager.dll", _
IconIndex:=0, IconLabel:=Sheets(1).Cells(n, 14)

试试看。

Sub add_link()
On Error GoTo err_exit
' Range("A3:A65535").ClearContents
Range("I3:I65535").ClearContents
Range("J3:K65535").ClearContents
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vritem As Variant
With fd
If .Show = -1 Then
i = 0
For Each vritem In .SelectedItems
i = i + 1
dname = vritem
Next vritem
If i >= 2 Then
MsgBox ("不能够选择多个文件夹，请重新选择")
Exit Sub
End If
End If
End With
Set fd = Nothing
dir_name = (dname & "")
strfilename = Dir(dir_name)
' Dim obj As Object
' Set obj = Application.COMAddIns.Item("prjAddin.Office_Addin").Object '获取myEXCEL.net的编程接口
J = 0
n = 3
Do While strfilename <> ""
Sheets(1).Cells(n, 15) = strfilename
Sheets(1).Cells(n, 14) = strfilename
'Sheets(1).Hyperlinks.Add Anchor:=Sheets(1).Cells(n, 14), Address:=dir_name & strfilename
Sheets(1).OLEObjects.Add Filename:=dir_name & strfilename, Link:=False, _
DisplayAsIcon:=True, IconFileName:="C:\Windows\system32\packager.dll", _
IconIndex:=0, IconLabel:=Sheets(1).Cells(n, 14)
n = n + 1
J = J + 1
strfilename = Dir
Loop
err_exit:
Exit Sub
End Sub

复制代码

toddbckele · 发表于 2015-6-8 18:14

roych 发表于 2015-6-8 17:01
修改为：
Sheets(1).OLEObjects.Add Filename:=dir_name & strfilename, Link:=False, _
Dis ...

嗯嗯。。非常感谢啊。。我先试试

toddbckele · 发表于 2015-6-8 18:25

toddbckele 发表于 2015-6-8 18:14
嗯嗯。。非常感谢啊。。我先试试

这样也不对的呢。。这样好像每个文件都产生一个小窗口了，我们用的是Myexcel程序开发的我附上一份附件我需要的是像附件一样链接到单元格当中去的。。然后保存更新到数据库~~！！

toddbckele · 发表于 2015-6-8 18:28

roych 发表于 2015-6-8 17:01
修改为：
Sheets(1).OLEObjects.Add Filename:=dir_name & strfilename, Link:=False, _
Dis ...

最后行号 = Sheets("sheet5").Range("T65536").End(xlUp).Row

Dim sErr As String '定义接口变量
Dim sResult As String
Dim obj As Object
Dim str_doc
Set obj = Application.COMAddIns.Item("prjAddin.Office_Addin").Object '获取myEXCEL.net的编程接口
For k = 3 To 最后行号
      str_doc = str & str_time & "\" & Cells(k, "T") & "\" & Cells(k, "T") & "\"
      Cells(k, "M").Select
      If Cells(k, "V") >= 1 Then
         obj.AddLinkFile str_doc & Cells(k, "L")
      Else
         l = CreateObject("scripting.FileSystemObject").GetFolder(str_doc & Cells(k, "T") & "\").Files.Count '判断包含文件个数
         Cells(k, "J") = l
         If l = 1 Then
            obj.AddLinkFile str_doc & Cells(k, "T") & "\000001.tif"
         Else
            obj.AddLinkFile str_doc & Cells(k, "T") & ".zip" '通过接口调用GetDefaultSysDataRuleValue
         End If
      End If
Next k
Set obj = Nothing '释放编程接口

toddbckele · 发表于 2015-6-8 18:28

toddbckele 发表于 2015-6-8 18:28
最后行号 = Sheets("sheet5").Range("T65536").End(xlUp).Row

Dim sErr As String '定义接口变 ...

类似于这样用处的代码如何给他加入到我的文档中去呢？

roych · 发表于 2015-6-9 15:34

toddbckele 发表于 2015-6-8 18:28
最后行号 = Sheets("sheet5").Range("T65536").End(xlUp).Row

Dim sErr As String '定义接口变 ...

如何更新数据库我并不关心。我只知道，Excel不支持OLE长二进制数据。如果非要导入到其它数据库（例如SQL Server、Access等等），请不要在Excel里处理。
——除非数据库保存的是路径。不过，话又说回来，如果路径相对固定的话，根本不必要去保存路径。
当然，你也可以使用图片格式来保存。但是强制放在一个单元格内，好看吗？
如果需要上传什么的，完全可以用FileCopy来完成文件的复制。
给的这段代码我已经看了。

我想说的是，即便封装了其它自定义的类库，能够起到优化程序或者界面的作用，如果没有提供API示例，完全不必要去引用。就这段代码而言，除了免去逐个去引用库之外，我并不觉得用这个插件有什么优势。事实上，如果你了解引用内置库的好处，估计就不会去引用这些库了：

绝大部分情况下，分发到客户端时，内置库不会丢失。——第三方的就难说了。
内置库在帮助文件或网络上有相对完整的API接口程序示例。
学习一个内置库，可以熟悉同一类的编程。例如Dim fso As New FileSystemObject在JavaScript中可以改为：CreateActiveXObject("Scripting.FileSystemObject")来使用（当然，前提是使用IE浏览器）。——如果改为其它库，可以吗？别的不说，你怎么引用这个库还是个问题。

你完全可以引用Microsoft Scripting runtime库来完成这部分操作。大体是：
Dim fso As New FileSystemObject
dim fl as File
fso.GetFold(你的路径)'获取文件夹路径。还可以加上files/subfolds集合获取文件夹下的文件/子文件夹。具体请参考以下帖子：
http://www.excelpx.com/forum.php?mod=viewthread&tid=365551

toddbckele · 发表于 2015-6-9 16:27

roych 发表于 2015-6-9 15:34
如何更新数据库我并不关心。我只知道，Excel不支持OLE长二进制数据。如果非要导入到其它数据库（例如 ...

非常感谢这么详细和专业的回答，但是我还是没怎么学会用

挺尴尬的。。。其实我就是想模仿那个把超链接的形式用获取myexcel 接口形式连接上文件。

		自动登录	找回密码
密码			注册